{-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE BinaryLiterals #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE DeriveDataTypeable #-} module Phoityne.IO.GUI.GTK.SearchResultTable ( SearchResultListStore , SearchResultOffset , SearchResultData(..) , SearchResultTableDoubleClickedHandler , createSearchResultListStore , setupSearchResultTable , addSearchReslutTable , clearSearchResultTable , activateSearchResultTab , prevCurrentSearchResult , nextCurrentSearchResult , getCurrentSearchResult , getSearchResultDataByFilePath ) where -- モジュール import Phoityne.IO.GUI.GTK.Constant import Phoityne.Constant -- システム import Graphics.UI.Gtk import System.Log.Logger import Control.Monad.IO.Class -- | -- -- data SearchResultData = SearchResultData { filePathSearchResultData :: String , lineNoSearchResultData :: Int , startColSearchResultData :: Int , endColSearchResultData :: Int , lineSearchResultData :: String } deriving (Show, Read, Eq, Ord) -- | -- -- type SearchResultOffset = (FilePath, Int) -- | -- -- type SearchResultListStore = ListStore SearchResultData -- | -- -- type SearchResultTableDoubleClickedHandler = SearchResultData -> IO () -- | -- -- createSearchResultListStore :: IO SearchResultListStore createSearchResultListStore = listStoreNew ([] :: [SearchResultData]) -- | -- -- setupSearchResultTable :: Builder -> SearchResultListStore -> SearchResultTableDoubleClickedHandler -> IO () setupSearchResultTable builder store evh = do treeView <- builderGetObject builder castToTreeView "SearchResultTreeView" col <- builderGetObject builder castToTreeViewColumn ("SearchResultTreeViewFilePathColumn" :: String) renderer <- cellRendererTextNew cellLayoutPackStart col renderer True cellLayoutSetAttributes col renderer store $ \cell -> [ cellText := filePathSearchResultData cell ] _ <- treeViewSetModel treeView store col <- builderGetObject builder castToTreeViewColumn ("SearchResultTreeViewLineNoColumn" :: String) renderer <- cellRendererTextNew cellLayoutPackStart col renderer True cellLayoutSetAttributes col renderer store $ \cell -> [ cellText := show (lineNoSearchResultData cell) ] _ <- treeViewSetModel treeView store col <- builderGetObject builder castToTreeViewColumn ("SearchResultTreeViewStartColColumn" :: String) renderer <- cellRendererTextNew cellLayoutPackStart col renderer True cellLayoutSetAttributes col renderer store $ \cell -> [ cellText := show (startColSearchResultData cell) ] _ <- treeViewSetModel treeView store col <- builderGetObject builder castToTreeViewColumn ("SearchResultTreeViewEndColColumn" :: String) renderer <- cellRendererTextNew cellLayoutPackStart col renderer True cellLayoutSetAttributes col renderer store $ \cell -> [ cellText := show (endColSearchResultData cell) ] _ <- treeViewSetModel treeView store col <- builderGetObject builder castToTreeViewColumn ("SearchResultTreeViewLineColumn" :: String) renderer <- cellRendererTextNew cellLayoutPackStart col renderer True cellLayoutSetAttributes col renderer store $ \cell -> [ cellText := lineSearchResultData cell ] _ <- treeViewSetModel treeView store _ <- on treeView buttonPressEvent $ searchResultTableDoubleClickedHandler treeView store evh sel <- treeViewGetSelection treeView treeSelectionSetMode sel SelectionSingle bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_DEL_SEARCH onToolButtonClicked bt $ delSearchBTClickedEventHandler builder store widgetShowAll treeView -- | -- -- searchResultTableDoubleClickedHandler :: TreeView -> ListStore SearchResultData -> SearchResultTableDoubleClickedHandler -> EventM EButton Bool searchResultTableDoubleClickedHandler self listStore evh = eventClick >>= \case DoubleClick -> do liftIO $ do sel <- treeViewGetSelection self treeSelectionGetSelected sel >>= \case Nothing -> return False Just iter -> do let idx = listStoreIterToIndex iter bpDat <- listStoreGetValue listStore idx evh bpDat return False _ -> return False -- | -- -- delSearchBTClickedEventHandler :: Builder -> ListStore SearchResultData -> IO () delSearchBTClickedEventHandler _ store = clearSearchResultTable store -- | -- -- activateSearchResultTab :: Builder -> IO () activateSearchResultTab builder = do child <- builderGetObject builder castToWidget "SearchResultBox" note <- builderGetObject builder castToNotebook "RightSubNote" idx <- get note $ notebookChildPosition child notebookSetCurrentPage note idx -- | -- -- addSearchReslutTable :: ListStore SearchResultData -> SearchResultData -> IO () addSearchReslutTable store dat = listStoreAppend store dat >> return () -- | -- -- clearSearchResultTable :: ListStore SearchResultData -> IO () clearSearchResultTable = listStoreClear -- | -- -- prevCurrentSearchResult :: Builder -> ListStore SearchResultData -> IO () prevCurrentSearchResult builder store = do treeView <- builderGetObject builder castToTreeView "SearchResultTreeView" modelMay <- treeViewGetModel treeView prevCurrentSearchResultWithModel treeView store modelMay -- | -- -- prevCurrentSearchResultWithModel :: TreeView -> ListStore SearchResultData -> Maybe TreeModel -> IO () prevCurrentSearchResultWithModel _ _ Nothing = errorM _LOG_NAME $ "[nextCurrentSearchResultWithModel] invalid search result tree view." prevCurrentSearchResultWithModel treeView _ (Just model) = do sel <- treeViewGetSelection treeView treeSelectionGetSelected sel >>= \case Nothing -> treeModelGetIterEnd model >>= \case Nothing -> return () -- table is empty Just iter -> selectRow model sel iter Just iter -> treeModelIterPrev model iter >>= \case Nothing -> treeModelGetIterEnd model >>= \case Nothing -> return () -- table is empty Just iter -> selectRow model sel iter Just iter -> selectRow model sel iter where selectRow model sel iter = do treeSelectionSelectIter sel iter treePath <- treeModelGetPath model iter treeViewScrollToCell treeView (Just treePath) Nothing Nothing -- | -- -- treeModelIterPrev :: TreeModel -> TreeIter -> IO (Maybe TreeIter) treeModelIterPrev model iter = treeModelGetPath model iter >>= \case [] -> return Nothing xs -> if 0 == head xs then return Nothing else treeModelIterNthChild model Nothing $ (head xs) - 1 -- | -- -- treeModelGetIterEnd :: TreeModel -> IO (Maybe TreeIter) treeModelGetIterEnd model = do count <- treeModelIterNChildren model Nothing treeModelIterNthChild model Nothing $ count - 1 -- | -- -- nextCurrentSearchResult :: Builder -> ListStore SearchResultData -> Maybe SearchResultOffset -> IO () nextCurrentSearchResult builder store offset = do treeView <- builderGetObject builder castToTreeView "SearchResultTreeView" modelMay <- treeViewGetModel treeView nextCurrentSearchResultWithModel treeView store modelMay offset -- | -- -- nextCurrentSearchResultWithModel :: TreeView -> ListStore SearchResultData -> Maybe TreeModel -> Maybe SearchResultOffset -> IO () nextCurrentSearchResultWithModel _ _ Nothing _ = errorM _LOG_NAME $ "[nextCurrentSearchResultWithModel] invalid search result tree view." nextCurrentSearchResultWithModel treeView store (Just model) (Just (path, lineNo))= do sel <- treeViewGetSelection treeView treeModelGetIterFirst model >>= \case Nothing -> return () Just firstIter -> findIter firstIter >>= \case Nothing -> treeSelectionSelectIter sel firstIter Just curIter -> do treeSelectionSelectIter sel curIter treePath <- treeModelGetPath model curIter treeViewScrollToCell treeView (Just treePath) Nothing Nothing where findIter iter = do (SearchResultData pathSR lineNoSR _ _ _) <- listStoreGetValue store (listStoreIterToIndex iter) if (path == pathSR) && (lineNo <= lineNoSR) then return (Just iter) else treeModelIterNext model iter >>= \case Nothing -> return Nothing Just nextIter -> findIter nextIter nextCurrentSearchResultWithModel treeView _ (Just model) Nothing = do sel <- treeViewGetSelection treeView treeSelectionGetSelected sel >>= \case Nothing -> treeModelGetIterFirst model >>= \case Nothing -> return () Just firstIter -> treeSelectionSelectIter sel firstIter Just iter -> do treeModelIterNext model iter >>= \case Nothing -> treeModelGetIterFirst model >>= \case Nothing -> return () Just firstIter -> treeSelectionSelectIter sel firstIter Just nextIter -> do treeSelectionSelectIter sel nextIter treePath <- treeModelGetPath model nextIter treeViewScrollToCell treeView (Just treePath) Nothing Nothing -- | -- -- getCurrentSearchResult :: Builder -> ListStore SearchResultData -> IO (Maybe SearchResultData) getCurrentSearchResult builder store = do getCurrentSearchResultIter builder store >>= \case Nothing -> return Nothing Just iter -> Just <$> listStoreGetValue store (listStoreIterToIndex iter) -- | -- -- getCurrentSearchResultIter :: Builder -> ListStore SearchResultData -> IO (Maybe TreeIter) getCurrentSearchResultIter builder store = do treeView <- builderGetObject builder castToTreeView "SearchResultTreeView" modelMay <- treeViewGetModel treeView getCurrentSearchResultIterWithModel treeView store modelMay -- | -- -- getCurrentSearchResultIterWithModel :: TreeView -> ListStore SearchResultData -> Maybe TreeModel -> IO (Maybe TreeIter) getCurrentSearchResultIterWithModel _ _ Nothing = do errorM _LOG_NAME $ "[getCurrentSearchResultIterWithModel] invalid search result tree view." return Nothing getCurrentSearchResultIterWithModel treeView _ (Just model) = do sel <- treeViewGetSelection treeView treeSelectionGetSelected sel >>= \case Just iter -> return $ Just iter Nothing -> treeModelGetIterFirst model >>= \case Nothing -> return Nothing Just firstIter -> do treeSelectionSelectIter sel firstIter return $ Just firstIter -- | -- -- getSearchResultDataByFilePath :: SearchResultListStore -> FilePath -> IO [SearchResultData] getSearchResultDataByFilePath store path = do datas <- listStoreToList store return $ filter ((path ==) . filePathSearchResultData) datas