module IDE.Pane.Workspace (
WorkspaceState
, IDEWorkspace
, updateWorkspace
, getWorkspace
, showWorkspace
) where
import Graphics.UI.Gtk hiding (get)
import Graphics.UI.Gtk.Gdk.Events
import Data.Maybe
import Control.Monad.Reader
import Data.Typeable
import IDE.Core.State
import IDE.Workspaces
import qualified Data.Map as Map (empty)
import Data.List (sortBy)
data IDEWorkspace = IDEWorkspace {
scrolledView :: ScrolledWindow
, treeViewC :: TreeView
, workspaceStore :: ListStore (Bool,IDEPackage)
, topBox :: VBox
} deriving Typeable
instance Pane IDEWorkspace IDEM
where
primPaneName _ = "Workspace"
getAddedIndex _ = 0
getTopWidget = castToWidget . topBox
paneId b = "*Workspace"
data WorkspaceState = WorkspaceState
deriving(Eq,Ord,Read,Show,Typeable)
instance RecoverablePane IDEWorkspace WorkspaceState IDEM where
saveState p = do
return (Just WorkspaceState)
recoverState pp WorkspaceState = do
nb <- getNotebook pp
buildPane pp nb builder
buildPane pp nb builder = do
res <- buildThisPane pp nb builder
when (isJust res) $ updateWorkspace True False
return res
builder pp nb windows = reifyIDE $ \ideR -> do
listStore <- listStoreNew []
treeView <- treeViewNew
treeViewSetModel treeView listStore
renderer0 <- cellRendererPixbufNew
col0 <- treeViewColumnNew
treeViewColumnSetTitle col0 "Active"
treeViewColumnSetSizing col0 TreeViewColumnAutosize
treeViewColumnSetResizable col0 True
treeViewColumnSetReorderable col0 True
treeViewAppendColumn treeView col0
cellLayoutPackStart col0 renderer0 True
cellLayoutSetAttributes col0 renderer0 listStore
$ \row -> [cellPixbufStockId :=
if (\(b,_)-> b) row
then stockYes
else ""]
renderer1 <- cellRendererTextNew
col1 <- treeViewColumnNew
treeViewColumnSetTitle col1 "Package"
treeViewColumnSetSizing col1 TreeViewColumnAutosize
treeViewColumnSetResizable col1 True
treeViewColumnSetReorderable col1 True
treeViewAppendColumn treeView col1
cellLayoutPackStart col1 renderer1 True
cellLayoutSetAttributes col1 renderer1 listStore
$ \row -> [ cellText := (\(_,pack)-> (packageIdentifierToString . ipdPackageId) pack) row ]
renderer2 <- cellRendererTextNew
col2 <- treeViewColumnNew
treeViewColumnSetTitle col2 "File path"
treeViewColumnSetSizing col2 TreeViewColumnAutosize
treeViewColumnSetResizable col2 True
treeViewColumnSetReorderable col2 True
treeViewAppendColumn treeView col2
cellLayoutPackStart col2 renderer2 True
cellLayoutSetAttributes col2 renderer2 listStore
$ \row -> [ cellText := (\(_,pack)-> ipdCabalFile pack) row ]
treeViewSetHeadersVisible treeView True
sel <- treeViewGetSelection treeView
treeSelectionSetMode sel SelectionSingle
sw <- scrolledWindowNew Nothing Nothing
containerAdd sw treeView
scrolledWindowSetPolicy sw PolicyAutomatic PolicyAutomatic
box <- vBoxNew False 2
boxPackEnd box sw PackGrow 0
let workspacePane = IDEWorkspace sw treeView listStore box
widgetShowAll box
cid1 <- treeView `afterFocusIn`
(\_ -> do reflectIDE (makeActive workspacePane) ideR ; return True)
treeView `onButtonPress` (treeViewPopup ideR workspacePane)
return (Just workspacePane,[ConnectC cid1])
getWorkspace :: Maybe PanePath -> IDEM IDEWorkspace
getWorkspace Nothing = forceGetPane (Right "*Workspace")
getWorkspace (Just pp) = forceGetPane (Left pp)
showWorkspace :: IDEAction
showWorkspace = do
l <- getWorkspace Nothing
displayPane l False
getSelectionTree :: TreeView
-> ListStore (Bool, IDEPackage)
-> IO (Maybe (Bool, IDEPackage))
getSelectionTree treeView listStore = do
treeSelection <- treeViewGetSelection treeView
rows <- treeSelectionGetSelectedRows treeSelection
case rows of
[[n]] -> do
val <- listStoreGetValue listStore n
return (Just val)
_ -> return Nothing
treeViewPopup :: IDERef
-> IDEWorkspace
-> Event
-> IO (Bool)
treeViewPopup ideR workspacePane (Button _ click _ _ _ _ button _ _) = do
if button == RightButton
then do
theMenu <- menuNew
item1 <- menuItemNewWithLabel "Activate Package"
item2 <- menuItemNewWithLabel "Add Package"
item3 <- menuItemNewWithLabel "Remove Package"
item1 `onActivateLeaf` do
sel <- getSelectionTree (treeViewC workspacePane)
(workspaceStore workspacePane)
case sel of
Just (_,ideP) -> reflectIDE (workspaceTry_ $ workspaceActivatePackage ideP) ideR
otherwise -> return ()
item2 `onActivateLeaf` reflectIDE (workspaceTry_ $ workspaceAddPackage) ideR
item3 `onActivateLeaf` do
sel <- getSelectionTree (treeViewC workspacePane)
(workspaceStore workspacePane)
case sel of
Just (_,ideP) -> reflectIDE (workspaceTry_ $ workspaceRemovePackage ideP) ideR
otherwise -> return ()
menuShellAppend theMenu item1
menuShellAppend theMenu item2
menuShellAppend theMenu item3
menuPopup theMenu Nothing
widgetShowAll theMenu
return True
else if button == LeftButton && click == DoubleClick
then do sel <- getSelectionTree (treeViewC workspacePane)
(workspaceStore workspacePane)
case sel of
Just (_,ideP) -> reflectIDE (workspaceTry_ $ workspaceActivatePackage ideP) ideR
>> return True
otherwise -> return False
else return False
treeViewPopup _ _ _ = throwIDE "treeViewPopup wrong event type"
updateWorkspace :: Bool -> Bool -> IDEAction
updateWorkspace showPane updateFileCache = do
mbWs <- readIDE workspace
case mbWs of
Nothing -> do
when updateFileCache $ modifyIDE_ (\ide -> ide{bufferProjCache = Map.empty})
mbMod <- getPane
case mbMod of
Nothing -> return ()
Just (p :: IDEWorkspace) -> do
liftIO $ listStoreClear (workspaceStore p)
when showPane $ displayPane p False
Just ws -> do
when updateFileCache $ modifyIDE_ (\ide -> ide{bufferProjCache = Map.empty})
mbMod <- getPane
case mbMod of
Nothing -> return ()
Just (p :: IDEWorkspace) -> do
liftIO $ listStoreClear (workspaceStore p)
let objs = map (\ ideP -> (Just (ipdCabalFile ideP) == wsActivePackFile ws, ideP))
(wsPackages ws)
let sorted = sortBy (\ (_,f) (_,s) -> compare (ipdPackageId f) (ipdPackageId s)) objs
liftIO $ mapM_ (listStoreAppend (workspaceStore p)) sorted
when showPane $ displayPane p False