leksah-0.4.0.3: src/IDE/Pane/Search.hs
{-# OPTIONS_GHC -XDeriveDataTypeable -XMultiParamTypeClasses -XTypeSynonymInstances
-XScopedTypeVariables #-}
-----------------------------------------------------------------------------
--
-- Module : IDE.Pane.Search
-- Copyright : (c) Juergen Nicklisch-Franken (aka Jutaro)
-- License : GNU-GPL
--
-- Maintainer : Juergen Nicklisch-Franken <info at leksah.org>
-- Stability : experimental
-- Portability : portable
--
-- | The pane of ide where metadata searches can be done
--
-------------------------------------------------------------------------------
module IDE.Pane.Search (
IDESearch(..)
, SearchState
, showSearch
, setChoices
, searchMetaGUI
) where
import Graphics.UI.Gtk hiding (get)
import qualified Graphics.UI.Gtk.ModelView as New
import Graphics.UI.Gtk.Gdk.Events
import Data.IORef (newIORef)
import Data.IORef (writeIORef,readIORef,IORef(..))
import IDE.Pane.Info (setInfo,IDEInfo(..))
import IDE.Pane.SourceBuffer (goToDefinition)
--import Debug.Trace (trace)
import IDE.Metainfo.Provider (searchMeta)
import Data.Maybe
import Control.Monad.Reader
--import Distribution.Package
import Data.Typeable
import IDE.Core.State
import Distribution.Text(display)
import Control.Event (triggerEvent)
import Debug.Trace (trace)
-- | A search pane description
--
data IDESearch = IDESearch {
scrolledView :: ScrolledWindow
, treeView :: New.TreeView
, searchStore :: New.ListStore Descr
, searchStringRef :: IORef String
, searchScopeRef :: IORef Scope
, searchModeRef :: IORef SearchMode
, topBox :: VBox
} deriving Typeable
data SearchState = SearchState {
searchString :: String
, searchScope :: Scope
, searchMode :: SearchMode
} deriving(Eq,Ord,Read,Show,Typeable)
instance IDEObject IDESearch
instance Pane IDESearch IDEM
where
primPaneName _ = "Search"
getAddedIndex _ = 0
getTopWidget = castToWidget . topBox
paneId b = "*Search"
makeActive p = activatePane p []
close pane = do
(panePath,_) <- guiPropertiesFromName (paneName pane)
nb <- getNotebook panePath
mbI <- liftIO $notebookPageNum nb (getTopWidget pane)
case mbI of
Nothing -> liftIO $ do
sysMessage Normal "notebook page not found: unexpected"
return ()
Just i -> do
deactivatePaneIfActive pane
liftIO $ do
notebookRemovePage nb i
widgetDestroy (getTopWidget pane)
removePaneAdmin pane
instance RecoverablePane IDESearch SearchState IDEM where
saveState p = do
str <- liftIO $ readIORef (searchStringRef p)
mode <- liftIO $ readIORef (searchModeRef p)
scope <- liftIO $ readIORef (searchScopeRef p)
return (Just (SearchState str scope mode))
recoverState pp (SearchState str scope mode) = do
nb <- getNotebook pp
initSearch pp nb scope mode
searchMetaGUI str
showSearch :: IDEAction
showSearch = do
m <- getSearch
liftIO $ bringPaneToFront m
liftIO $ widgetGrabFocus (treeView m)
getSearch :: IDEM IDESearch
getSearch = do
mbSearch <- getPane
case mbSearch of
Just m -> return m
Nothing -> do
prefs <- readIDE prefs
layout <- readIDE layout
let pp = getStandardPanePath (modulesPanePath prefs) layout
nb <- getNotebook pp
initSearch pp nb System (Prefix False)
mbSearch <- getPane
case mbSearch of
Nothing -> throwIDE "Can't init search"
Just m -> return m
initSearch :: PanePath -> Notebook -> Scope -> SearchMode -> IDEAction
initSearch panePath nb scope mode = do
panes <- readIDE panes
paneMap <- readIDE paneMap
prefs <- readIDE prefs
currentInfo <- readIDE currentInfo
(buf,cids) <- reifyIDE $ \ideR -> do
scopebox <- hBoxNew True 2
rb1 <- radioButtonNewWithLabel "Local"
rb2 <- radioButtonNewWithLabelFromWidget rb1 "Package"
rb3 <- radioButtonNewWithLabelFromWidget rb1 "System"
toggleButtonSetActive
(case scope of
Local -> rb1
Package -> rb2
System -> rb3) True
boxPackStart scopebox rb1 PackNatural 2
boxPackStart scopebox rb2 PackNatural 2
boxPackEnd scopebox rb3 PackNatural 2
modebox <- hBoxNew True 2
mb1 <- radioButtonNewWithLabel "Exact"
mb2 <- radioButtonNewWithLabelFromWidget mb1 "Prefix"
mb3 <- radioButtonNewWithLabelFromWidget mb1 "Regex"
toggleButtonSetActive
(case mode of
Exact _ -> mb1
Prefix _ -> mb2
Regex _ -> mb3) True
mb4 <- checkButtonNewWithLabel "Case sensitive"
toggleButtonSetActive mb4 (caseSense mode)
boxPackStart modebox mb1 PackNatural 2
boxPackStart modebox mb2 PackNatural 2
boxPackStart modebox mb3 PackNatural 2
boxPackEnd modebox mb4 PackNatural 2
listStore <- New.listStoreNew []
treeView <- New.treeViewNew
New.treeViewSetModel treeView listStore
renderer3 <- New.cellRendererTextNew
renderer30 <- New.cellRendererPixbufNew
col3 <- New.treeViewColumnNew
New.treeViewColumnSetTitle col3 "Symbol"
New.treeViewColumnSetSizing col3 TreeViewColumnAutosize
New.treeViewColumnSetResizable col3 True
New.treeViewColumnSetReorderable col3 True
New.treeViewAppendColumn treeView col3
New.cellLayoutPackStart col3 renderer30 False
New.cellLayoutPackStart col3 renderer3 True
New.cellLayoutSetAttributes col3 renderer3 listStore
$ \row -> [ New.cellText := descrName row]
New.cellLayoutSetAttributes col3 renderer30 listStore
$ \row -> [
New.cellPixbufStockId := stockIdFromType ((descrType . details) row)]
renderer1 <- New.cellRendererTextNew
renderer10 <- New.cellRendererPixbufNew
col1 <- New.treeViewColumnNew
New.treeViewColumnSetTitle col1 "Module"
New.treeViewColumnSetSizing col1 TreeViewColumnAutosize
New.treeViewColumnSetResizable col1 True
New.treeViewColumnSetReorderable col1 True
New.treeViewAppendColumn treeView col1
New.cellLayoutPackStart col1 renderer10 False
New.cellLayoutPackStart col1 renderer1 True
New.cellLayoutSetAttributes col1 renderer1 listStore
$ \row -> [ New.cellText := display $ modu $ descrModu' row]
New.cellLayoutSetAttributes col1 renderer10 listStore
$ \row -> [
New.cellPixbufStockId := if isReexported row
then "ide_reexported"
else if isJust (mbLocation row)
then "ide_source"
else ""]
renderer2 <- New.cellRendererTextNew
col2 <- New.treeViewColumnNew
New.treeViewColumnSetTitle col2 "Package"
New.treeViewColumnSetSizing col2 TreeViewColumnAutosize
New.treeViewColumnSetResizable col2 True
New.treeViewColumnSetReorderable col2 True
New.treeViewAppendColumn treeView col2
New.cellLayoutPackStart col2 renderer2 True
New.cellLayoutSetAttributes col2 renderer2 listStore
$ \row -> [ New.cellText := display $ pack $ descrModu' row]
New.treeViewSetHeadersVisible treeView True
sel <- New.treeViewGetSelection treeView
New.treeSelectionSetMode sel SelectionSingle
sw <- scrolledWindowNew Nothing Nothing
containerAdd sw treeView
scrolledWindowSetPolicy sw PolicyAutomatic PolicyAutomatic
box <- vBoxNew False 2
boxPackStart box scopebox PackNatural 0
boxPackStart box sw PackGrow 0
boxPackEnd box modebox PackNatural 0
stringRef <- newIORef ""
scopeRef <- newIORef scope
modeRef <- newIORef mode
let search = IDESearch sw treeView listStore stringRef scopeRef modeRef box
notebookInsertOrdered nb box (paneName search) Nothing
widgetShowAll box
cid1 <- treeView `afterFocusIn`
(\_ -> do reflectIDE (makeActive search) ideR ; return True)
rb1 `onToggled` (reflectIDE (scopeSelection Local) ideR )
rb2 `onToggled` (reflectIDE (scopeSelection Package) ideR )
rb3 `onToggled` (reflectIDE (scopeSelection System) ideR )
mb1 `onToggled` do
widgetSetSensitivity mb4 False
active <- toggleButtonGetActive mb4
(reflectIDE (modeSelection (Exact active)) ideR )
mb2 `onToggled`do
widgetSetSensitivity mb4 True
active <- toggleButtonGetActive mb4
(reflectIDE (modeSelection (Prefix active)) ideR )
mb3 `onToggled` do
widgetSetSensitivity mb4 True
active <- toggleButtonGetActive mb4
(reflectIDE (modeSelection (Regex active)) ideR )
mb4 `onToggled` do
active <- toggleButtonGetActive mb4
(reflectIDE (modeSelectionCase active) ideR )
treeView `onButtonPress` (listViewPopup ideR listStore treeView)
sel `New.onSelectionChanged` do
fillInfo treeView listStore ideR
trace "search pane selection changes" $ return ()
return (search,[ConnectC cid1])
addPaneAdmin buf cids panePath
liftIO $widgetGrabFocus (scrolledView buf)
getScope :: IDESearch -> IO Scope
getScope search = readIORef (searchScopeRef search)
getMode :: IDESearch -> IO SearchMode
getMode search = readIORef (searchModeRef search)
scopeSelection :: Scope -> IDEAction
scopeSelection scope = do
search <- getSearch
liftIO $ writeIORef (searchScopeRef search) scope
text <- liftIO $ readIORef (searchStringRef search)
searchMetaGUI text
modeSelection :: SearchMode -> IDEAction
modeSelection mode = do
search <- getSearch
liftIO $ writeIORef (searchModeRef search) mode
text <- liftIO $ readIORef (searchStringRef search)
searchMetaGUI text
modeSelectionCase :: Bool -> IDEAction
modeSelectionCase caseSense = do
search <- getSearch
oldMode <- liftIO $ readIORef (searchModeRef search)
liftIO $ writeIORef (searchModeRef search) oldMode{caseSense = caseSense}
text <- liftIO $ readIORef (searchStringRef search)
searchMetaGUI text
searchMetaGUI :: String -> IDEAction
searchMetaGUI str = do
search <- getSearch
liftIO $ bringPaneToFront search
liftIO $ writeIORef (searchStringRef search) str
scope <- liftIO $ getScope search
mode <- liftIO $ getMode search
let mode' = if length str > 2 then mode else Exact (caseSense mode)
descrs <- if null str
then return []
else searchMeta scope str mode'
liftIO $ do
New.listStoreClear (searchStore search)
mapM_ (New.listStoreAppend (searchStore search)) descrs
listViewPopup :: IDERef
-> New.ListStore Descr
-> New.TreeView
-> Event
-> IO (Bool)
listViewPopup ideR store descrView (Button _ click _ _ _ _ button _ _) = do
if button == RightButton
then do
theMenu <- menuNew
item1 <- menuItemNewWithLabel "Go to definition"
item1 `onActivateLeaf` do
sel <- getSelectionDescr descrView store
case sel of
Just descr -> reflectIDE
(goToDefinition descr) ideR
otherwise -> sysMessage Normal "Search >> listViewPopup: no selection"
menuShellAppend theMenu item1
menuPopup theMenu Nothing
widgetShowAll theMenu
return True
else if button == LeftButton && click == DoubleClick
then do sel <- getSelectionDescr descrView store
case sel of
Just descr -> reflectIDE (triggerEvent ideR (SelectIdent descr))
ideR >> return ()
otherwise -> sysMessage Normal "Search >> listViewPopup: no selection2"
return True
else do
mbPane :: Maybe IDEInfo <- reflectIDE getPane ideR
when (isJust mbPane) $ bringPaneToFront (fromJust mbPane)
return False
listViewPopup _ _ _ _ = throwIDE "listViewPopup wrong event type"
getSelectionDescr :: New.TreeView
-> New.ListStore Descr
-> IO (Maybe Descr)
getSelectionDescr treeView listStore = do
treeSelection <- New.treeViewGetSelection treeView
paths <- New.treeSelectionGetSelectedRows treeSelection
case paths of
[a]:r -> do
val <- New.listStoreGetValue listStore a
return (Just val)
_ -> return Nothing
fillInfo :: New.TreeView
-> New.ListStore Descr
-> IDERef
-> IO ()
fillInfo treeView listStore ideR = do
sel <- getSelectionDescr treeView listStore
case sel of
Just descr -> reflectIDE (setInfo descr) ideR
otherwise -> sysMessage Normal "Search>>fillInfo:no selection"
setChoices :: [Descr] -> IDEAction
setChoices descrs = do
search <- getSearch
liftIO $ do
New.listStoreClear (searchStore search)
mapM_ (New.listStoreAppend (searchStore search)) descrs
bringPaneToFront search
writeIORef (searchStringRef search) ""