{-# LANGUAGE FlexibleInstances, ScopedTypeVariables, TypeSynonymInstances, MultiParamTypeClasses, DeriveDataTypeable #-} ----------------------------------------------------------------------------- -- -- Module : IDE.Pane.Workspace -- Copyright : 2007-2011 Juergen Nicklisch-Franken, Hamish Mackenzie -- License : GPL -- -- Maintainer : maintainer@leksah.org -- Stability : provisional -- Portability : -- -- | -- ----------------------------------------------------------------------------- module IDE.Pane.Workspace ( WorkspaceState(..) , IDEWorkspace , updateWorkspace , getWorkspace , showWorkspace ) where import Graphics.UI.Gtk hiding (get) import Graphics.UI.Gtk.Gdk.EventM import Data.Maybe import Data.Typeable import IDE.Core.State import IDE.Workspaces import qualified Data.Map as Map (empty) import Data.List (sortBy) import IDE.Pane.Files (refreshFiles) import IDE.Pane.HLint (refreshHLint) import Control.Monad (when) import Control.Monad.IO.Class (MonadIO(..)) import IDE.Utils.GUIUtils (treeViewContextMenu, __) import System.Glib.Properties (newAttrFromMaybeStringProperty) import Data.Tree (Tree(..)) import System.Log.Logger (debugM) -- | Workspace pane state -- data IDEWorkspace = IDEWorkspace { scrolledView :: ScrolledWindow , treeViewC :: TreeView , workspaceStore :: TreeStore (Bool,IDEPackage,Maybe String) , topBox :: VBox } deriving Typeable instance Pane IDEWorkspace IDEM where primPaneName _ = (__ "Workspace") getAddedIndex _ = 0 getTopWidget = castToWidget . topBox paneId b = "*Workspace" -- | Nothing to remember here, everything comes from the IDE state 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 treeStore <- treeStoreNew [] treeView <- treeViewNew treeViewSetModel treeView treeStore 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 treeStore $ \row -> [newAttrFromMaybeStringProperty "stock-id" := if (\(b,_,_)-> b) row then Just stockYes else Nothing] 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 treeStore $ \row -> [ cellText := name 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 treeStore $ \row -> [ cellText := file 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 treeStore box widgetShowAll box cid1 <- treeView `after` focusInEvent $ do liftIO $ reflectIDE (makeActive workspacePane) ideR return True (cid2, cid3) <- treeViewContextMenu treeView $ workspaceContextMenu ideR workspacePane cid4 <- treeView `on` rowActivated $ workspaceSelect ideR workspacePane return (Just workspacePane, map ConnectC [cid1, cid2, cid3, cid4]) where name (_, _, Just exe) = exe name (_, pack, _) = packageIdentifierToString $ ipdPackageId pack file (_, _, Just _) = "" file (_, pack, _) = ipdCabalFile pack 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 -> TreeStore (Bool, IDEPackage, Maybe String) -> IO (Maybe (Bool, IDEPackage, Maybe String)) getSelectionTree treeView treeStore = do liftIO $ debugM "leksah" "getSelectionTree" treeSelection <- treeViewGetSelection treeView rows <- treeSelectionGetSelectedRows treeSelection case rows of [path] -> do val <- treeStoreGetValue treeStore path return (Just val) _ -> return Nothing workspaceContextMenu :: IDERef -> IDEWorkspace -> Menu -> IO () workspaceContextMenu ideR workspacePane theMenu = do item1 <- menuItemNewWithLabel (__ "Activate Package") item2 <- menuItemNewWithLabel (__ "Add Package") item3 <- menuItemNewWithLabel (__ "Remove Package") item1 `on` menuItemActivate $ do sel <- getSelectionTree (treeViewC workspacePane) (workspaceStore workspacePane) case sel of Just (_,ideP,mbExe) -> reflectIDE (workspaceTry $ workspaceActivatePackage ideP mbExe) ideR otherwise -> return () item2 `on` menuItemActivate $ reflectIDE (workspaceTry $ workspaceAddPackage) ideR item3 `on` menuItemActivate $ 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 workspaceSelect :: IDERef -> IDEWorkspace -> TreePath -> TreeViewColumn -> IO () workspaceSelect ideR workspacePane path _ = do liftIO $ debugM "leksah" "workspaceSelect" (_,ideP,mbExe) <- treeStoreGetValue (workspaceStore workspacePane) path reflectIDE (workspaceTry $ workspaceActivatePackage ideP mbExe) ideR updateWorkspace :: Bool -> Bool -> IDEAction updateWorkspace showPane updateFileCache = do liftIO $ debugM "leksah" "updateWorkspace" 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 $ treeStoreClear (workspaceStore p) when showPane $ displayPane p False refreshFiles Just ws -> do when updateFileCache $ modifyIDE_ (\ide -> ide{bufferProjCache = Map.empty}) mbMod <- getPane case mbMod of Nothing -> return () Just (p :: IDEWorkspace) -> do liftIO $ treeStoreClear (workspaceStore p) let sorted = sortBy (\ f s -> compare (ipdPackageId f) (ipdPackageId s)) $ wsPackages ws forest = map (\ ideP -> Node (Just (ipdCabalFile ideP) == wsActivePackFile ws, ideP, Nothing) (map (\ test -> Node ( Just (ipdCabalFile ideP) == wsActivePackFile ws && Just test == wsActiveExe ws, ideP, Just test) []) $ ipdExes ideP ++ ipdTests ideP)) sorted liftIO $ treeStoreInsertForest (workspaceStore p) [] 0 forest when showPane $ displayPane p False refreshFiles workspaceTry refreshHLint