module IDE.Pane.Info (
IDEInfo
, InfoState
, setInfo
, replayInfoHistory
, openDocu
) where
import Graphics.UI.Gtk hiding (afterToggleOverwrite)
import Control.Monad
import Control.Monad.Trans
import Data.IORef
import Data.Typeable
import Data.Char (isAlphaNum)
import Network.URI (escapeURIString)
import IDE.Core.State
import IDE.Pane.SourceBuffer
import IDE.Utils.GUIUtils (openBrowser,controlIsPressed)
import Graphics.UI.Gtk.SourceView
data IDEInfo = IDEInfo {
sw :: VBox
, currentDescr :: IORef (Maybe Descr)
, descriptionView :: SourceView
} deriving Typeable
data InfoState = InfoState (Maybe Descr)
deriving(Eq,Ord,Read,Show,Typeable)
instance Pane IDEInfo IDEM
where
primPaneName _ = "Info"
getAddedIndex _ = 0
getTopWidget = castToWidget . sw
paneId b = "*Info"
instance RecoverablePane IDEInfo InfoState IDEM where
saveState p = do
currentDescr' <- liftIO $ readIORef (currentDescr p)
return (Just (InfoState currentDescr'))
recoverState pp (InfoState descr) = do
nb <- getNotebook pp
buildPane pp nb builder
builder pp nb windows =
let idDescr = Nothing in do
prefs <- readIDE prefs
reifyIDE $ \ ideR -> do
ibox <- vBoxNew False 0
font <- case textviewFont prefs of
Just str -> do
fontDescriptionFromString str
Nothing -> do
f <- fontDescriptionNew
fontDescriptionSetFamily f "Monospace"
return f
descriptionView <- sourceViewNew
descriptionBuffer <- (get descriptionView textViewBuffer) >>= (return . castToSourceBuffer)
lm <- sourceLanguageManagerNew
mbLang <- sourceLanguageManagerGuessLanguage lm Nothing (Just "text/x-haskell")
#if MIN_VERSION_gtksourceview2(0,12,0)
sourceBufferSetLanguage descriptionBuffer mbLang
#else
case mbLang of
Nothing -> return ()
Just lang -> do sourceBufferSetLanguage descriptionBuffer lang
#endif
sourceLanguageManagerGetLanguageIds lm
sourceBufferSetHighlightSyntax descriptionBuffer True
widgetModifyFont descriptionView (Just font)
case sourceStyle prefs of
(False,_) -> return ()
(True,str) -> do
styleManager <- sourceStyleSchemeManagerNew
ids <- sourceStyleSchemeManagerGetSchemeIds styleManager
when (elem str ids) $ do
scheme <- sourceStyleSchemeManagerGetScheme styleManager str
#if MIN_VERSION_gtksourceview2(0,12,0)
sourceBufferSetStyleScheme descriptionBuffer $ Just scheme
#else
sourceBufferSetStyleScheme descriptionBuffer scheme
#endif
sw <- scrolledWindowNew Nothing Nothing
containerAdd sw descriptionView
scrolledWindowSetPolicy sw PolicyAutomatic PolicyAutomatic
boxPackStart ibox sw PackGrow 10
--openType
currentDescr' <- newIORef idDescr
#if MIN_VERSION_gtk(0,10,5)
cid <- on descriptionView populatePopup (populatePopupMenu ideR currentDescr')
#else
cid <- descriptionView `onPopulatePopup` (populatePopupMenu ideR currentDescr')
#endif
let info = IDEInfo ibox currentDescr' descriptionView
descriptionView `widgetAddEvents` [ButtonReleaseMask]
id5 <- descriptionView `onButtonRelease`
(\ e -> do
buf <- textViewGetBuffer descriptionView
(l,r) <- textBufferGetSelectionBounds buf
symbol <- textBufferGetText buf l r True
when (controlIsPressed e)
(reflectIDE (do
triggerEventIDE (SelectInfo symbol)
return ()) ideR)
return False)
return (Just info,[ConnectC cid])
gotoSource :: IDEAction
gotoSource = do
mbInfo <- getInfoCont
case mbInfo of
Nothing -> do ideMessage Normal "gotoSource:noDefinition"
return ()
Just info -> goToDefinition info >> return ()
gotoModule' :: IDEAction
gotoModule' = do
mbInfo <- getInfoCont
case mbInfo of
Nothing -> return ()
Just info -> triggerEventIDE (SelectIdent info) >> return ()
setInfo :: Descr -> IDEAction
setInfo identifierDescr = do
info <- forceGetPane (Right "*Info")
oldDescr <- liftIO $ readIORef (currentDescr info)
liftIO $ do
writeIORef (currentDescr info) (Just identifierDescr)
tb <- get (descriptionView info) textViewBuffer
textBufferSetText tb (show (Present identifierDescr))
recordInfoHistory (Just identifierDescr) oldDescr
getInfoCont :: IDEM (Maybe (Descr))
getInfoCont = do
mbPane <- getPane
case mbPane of
Nothing -> return Nothing
Just p -> liftIO $ readIORef (currentDescr p)
recordInfoHistory :: Maybe Descr -> Maybe Descr -> IDEAction
recordInfoHistory descr oldDescr = do
triggerEventIDE (RecordHistory
((InfoElementSelected descr),
(InfoElementSelected oldDescr)))
return ()
replayInfoHistory :: Maybe Descr -> IDEAction
replayInfoHistory mbDescr = do
case mbDescr of
Nothing -> return ()
Just descr -> setInfo descr
openDocu :: IDEAction
openDocu = do
mbDescr <- getInfoCont
case mbDescr of
Nothing -> return ()
Just descr -> do
prefs' <- readIDE prefs
openBrowser $ docuSearchURL prefs' ++ (escapeURIString isAlphaNum $ dscName descr)
populatePopupMenu :: IDERef -> IORef (Maybe Descr) -> Menu -> IO ()
populatePopupMenu ideR currentDescr' menu = do
items <- containerGetChildren menu
item0 <- menuItemNewWithLabel "Goto Definition"
item0 `onActivateLeaf` (reflectIDE gotoSource ideR)
item1 <- menuItemNewWithLabel "Select Module"
item1 `onActivateLeaf` (reflectIDE gotoModule' ideR )
item2 <- menuItemNewWithLabel "Open Documentation"
item2 `onActivateLeaf` (reflectIDE openDocu ideR )
menuShellAppend menu item0
menuShellAppend menu item1
menuShellAppend menu item2
widgetShowAll menu
mapM_ widgetHide $ take 2 (reverse items)
return ()