module IDE.Pane.Search (
IDESearch(..)
, SearchState
, setChoices
, searchMetaGUI
, getSearch
) where
import Graphics.UI.Gtk
(listStoreGetValue, treeSelectionGetSelectedRows, widgetShowAll,
menuPopup, menuShellAppend, onActivateLeaf, menuItemNewWithLabel,
menuNew, listStoreAppend, listStoreClear, entrySetText,
afterKeyRelease, onKeyPress, onButtonPress, toggleButtonGetActive,
widgetSetSensitivity, onToggled, afterFocusIn, vBoxNew, entryNew,
scrolledWindowSetPolicy, containerAdd, scrolledWindowNew,
treeSelectionSetMode, treeViewGetSelection,
treeViewSetHeadersVisible, cellPixbufStockId, cellText,
cellLayoutSetAttributes, cellLayoutPackStart, treeViewAppendColumn,
treeViewColumnSetReorderable, treeViewColumnSetResizable,
treeViewColumnSetSizing, treeViewColumnSetTitle, treeViewColumnNew,
cellRendererPixbufNew, cellRendererTextNew, treeViewSetModel,
treeViewNew, listStoreNew, boxPackEnd, boxPackStart,
checkButtonNewWithLabel, toggleButtonSetActive,
radioButtonNewWithLabelFromWidget, radioButtonNewWithLabel,
hBoxNew, entryGetText, castToWidget, Entry, VBox, ListStore,
TreeView, ScrolledWindow, PolicyType(..), SelectionMode(..),
TreeViewColumnSizing(..), AttrOp(..),
Packing(..))
import Graphics.UI.Gtk.Gdk.Events
import Data.IORef (newIORef)
import Data.IORef (writeIORef,readIORef,IORef(..))
import IDE.Pane.SourceBuffer (goToDefinition)
import IDE.Metainfo.Provider (searchMeta)
import Data.Maybe
import Control.Monad.Reader
import Data.Typeable
import IDE.Core.State
import IDE.Utils.GUIUtils
import Distribution.Text(display)
import Control.Event (triggerEvent)
data IDESearch = IDESearch {
scrolledView :: ScrolledWindow
, treeView :: TreeView
, searchStore :: ListStore Descr
, searchScopeRef :: IORef Scope
, searchModeRef :: IORef SearchMode
, topBox :: VBox
, entry :: Entry
} deriving Typeable
data SearchState = SearchState {
searchString :: String
, searchScope :: Scope
, searchMode :: SearchMode
} deriving(Eq,Ord,Read,Show,Typeable)
instance Pane IDESearch IDEM
where
primPaneName _ = "Search"
getAddedIndex _ = 0
getTopWidget = castToWidget . topBox
paneId b = "*Search"
instance RecoverablePane IDESearch SearchState IDEM where
saveState p = do
str <- liftIO $ entryGetText (entry 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
mbP <- buildPane pp nb builder
scopeSelection scope
modeSelection mode
searchMetaGUI str
return mbP
builder pp nb windows =
let scope = SystemScope
mode = Prefix False
in reifyIDE $ \ ideR -> do
scopebox <- hBoxNew True 2
rb1 <- radioButtonNewWithLabel "Package"
rb2 <- radioButtonNewWithLabelFromWidget rb1 "Workspace"
rb3 <- radioButtonNewWithLabelFromWidget rb1 "System"
toggleButtonSetActive rb3 True
cb2 <- checkButtonNewWithLabel "Imports"
boxPackStart scopebox rb1 PackGrow 2
boxPackStart scopebox rb2 PackGrow 2
boxPackStart scopebox rb3 PackGrow 2
boxPackEnd scopebox cb2 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 <- listStoreNew []
treeView <- treeViewNew
treeViewSetModel treeView listStore
renderer3 <- cellRendererTextNew
renderer30 <- cellRendererPixbufNew
col3 <- treeViewColumnNew
treeViewColumnSetTitle col3 "Symbol"
treeViewColumnSetSizing col3 TreeViewColumnAutosize
treeViewColumnSetResizable col3 True
treeViewColumnSetReorderable col3 True
treeViewAppendColumn treeView col3
cellLayoutPackStart col3 renderer30 False
cellLayoutPackStart col3 renderer3 True
cellLayoutSetAttributes col3 renderer3 listStore
$ \row -> [ cellText := dscName row]
cellLayoutSetAttributes col3 renderer30 listStore
$ \row -> [
cellPixbufStockId := stockIdFromType ((descrType . dscTypeHint) row)]
renderer1 <- cellRendererTextNew
renderer10 <- cellRendererPixbufNew
col1 <- treeViewColumnNew
treeViewColumnSetTitle col1 "Module"
treeViewColumnSetSizing col1 TreeViewColumnAutosize
treeViewColumnSetResizable col1 True
treeViewColumnSetReorderable col1 True
treeViewAppendColumn treeView col1
cellLayoutPackStart col1 renderer10 False
cellLayoutPackStart col1 renderer1 True
cellLayoutSetAttributes col1 renderer1 listStore
$ \row -> [ cellText := case dsMbModu row of
Nothing -> ""
Just pm -> display $ modu pm]
cellLayoutSetAttributes col1 renderer10 listStore
$ \row -> [
cellPixbufStockId := if isReexported row
then "ide_reexported"
else if isJust (dscMbLocation row)
then "ide_source"
else ""]
renderer2 <- cellRendererTextNew
col2 <- treeViewColumnNew
treeViewColumnSetTitle col2 "Package"
treeViewColumnSetSizing col2 TreeViewColumnAutosize
treeViewColumnSetResizable col2 True
treeViewColumnSetReorderable col2 True
treeViewAppendColumn treeView col2
cellLayoutPackStart col2 renderer2 True
cellLayoutSetAttributes col2 renderer2 listStore
$ \row -> [ cellText := case dsMbModu row of
Nothing -> ""
Just pm -> display $ pack pm]
treeViewSetHeadersVisible treeView True
sel <- treeViewGetSelection treeView
treeSelectionSetMode sel SelectionSingle
sw <- scrolledWindowNew Nothing Nothing
containerAdd sw treeView
scrolledWindowSetPolicy sw PolicyAutomatic PolicyAutomatic
entry <- entryNew
box <- vBoxNew False 2
boxPackStart box scopebox PackNatural 0
boxPackStart box sw PackGrow 0
boxPackStart box modebox PackNatural 0
boxPackEnd box entry PackNatural 0
scopeRef <- newIORef scope
modeRef <- newIORef mode
let search = IDESearch sw treeView listStore scopeRef modeRef box entry
cid1 <- treeView `afterFocusIn`
(\_ -> do reflectIDE (makeActive search) ideR ; return True)
rb1 `onToggled` (reflectIDE (scopeSelection' rb1 rb2 rb3 cb2) ideR )
rb2 `onToggled` (reflectIDE (scopeSelection' rb1 rb2 rb3 cb2) ideR )
rb3 `onToggled` (reflectIDE (scopeSelection' rb1 rb2 rb3 cb2) ideR )
cb2 `onToggled` (reflectIDE (scopeSelection' rb1 rb2 rb3 cb2) 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` (handleEvent ideR listStore treeView)
treeView `onButtonPress` (handleEvent ideR listStore treeView)
treeView `onKeyPress` (handleEvent ideR listStore treeView)
entry `afterKeyRelease` (\ event -> do
text <- entryGetText entry
reflectIDE (searchMetaGUI text) ideR
return False)
return (Just search,[ConnectC cid1])
getScope :: IDESearch -> IO Scope
getScope search = readIORef (searchScopeRef search)
getMode :: IDESearch -> IO SearchMode
getMode search = readIORef (searchModeRef search)
getSearch :: Maybe PanePath -> IDEM IDESearch
getSearch Nothing = forceGetPane (Right "*Search")
getSearch (Just pp) = forceGetPane (Left pp)
scopeSelection' rb1 rb2 rb3 cb2 = do
scope <- liftIO $ do
withImports <- toggleButtonGetActive cb2
s1 <- toggleButtonGetActive rb1
s2 <- toggleButtonGetActive rb2
s3 <- toggleButtonGetActive rb3
if s1
then return (PackageScope withImports)
else if s2
then return (WorkspaceScope withImports)
else return (SystemScope)
scopeSelection scope
scopeSelection :: Scope -> IDEAction
scopeSelection scope = do
search <- getSearch Nothing
liftIO $ writeIORef (searchScopeRef search) scope
text <- liftIO $ entryGetText (entry search)
searchMetaGUI text
modeSelection :: SearchMode -> IDEAction
modeSelection mode = do
search <- getSearch Nothing
liftIO $ writeIORef (searchModeRef search) mode
text <- liftIO $ entryGetText (entry search)
searchMetaGUI text
modeSelectionCase :: Bool -> IDEAction
modeSelectionCase caseSense = do
search <- getSearch Nothing
oldMode <- liftIO $ readIORef (searchModeRef search)
liftIO $ writeIORef (searchModeRef search) oldMode{caseSense = caseSense}
text <- liftIO $ entryGetText (entry search)
searchMetaGUI text
searchMetaGUI :: String -> IDEAction
searchMetaGUI str = do
search <- getSearch Nothing
liftIO $ bringPaneToFront search
liftIO $ entrySetText (entry search) str
scope <- liftIO $ getScope search
mode <- liftIO $ getMode search
descrs <- if null str
then return []
else searchMeta scope str mode
liftIO $ do
listStoreClear (searchStore search)
mapM_ (listStoreAppend (searchStore search)) (take 500 descrs)
handleEvent :: IDERef
-> ListStore Descr
-> TreeView
-> Event
-> IO (Bool)
handleEvent ideR store descrView (Button {eventClick = click, eventButton = button}) = do
if button == RightButton
then do
theMenu <- menuNew
item1 <- menuItemNewWithLabel "Go to definition"
item1 `onActivateLeaf` (goToDef ideR store descrView)
menuShellAppend theMenu item1
menuPopup theMenu Nothing
widgetShowAll theMenu
return True
else if button == LeftButton && click == DoubleClick
then selectDescr ideR store descrView
else return False
handleEvent ideR store descrView (Key { eventKeyName = "Return"}) =
selectDescr ideR store descrView
handleEvent _ _ _ _ = return False
goToDef ideR store descrView = do
sel <- getSelectionDescr descrView store
case sel of
Just descr -> reflectIDE
(goToDefinition descr) ideR
otherwise -> sysMessage Normal "Search >> listViewPopup: no selection"
selectDescr ideR store descrView= 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
getSelectionDescr :: TreeView
-> ListStore Descr
-> IO (Maybe Descr)
getSelectionDescr treeView listStore = do
treeSelection <- treeViewGetSelection treeView
paths <- treeSelectionGetSelectedRows treeSelection
case paths of
[a]:r -> do
val <- listStoreGetValue listStore a
return (Just val)
_ -> return Nothing
setChoices :: [Descr] -> IDEAction
setChoices descrs = do
search <- getSearch Nothing
liftIO $ do
listStoreClear (searchStore search)
mapM_ (listStoreAppend (searchStore search)) descrs
bringPaneToFront search
entrySetText (entry search)
(case descrs of
[] -> ""
hd: _ -> dscName hd)