----------------------------------------------------------------------------- -- -- Module : VCSGui.Mercurial.Commit -- Copyright : 2011 Stephan Fortelny, Harald Jagenteufel -- License : GPL Nothing -- -- Maintainer : stephanfortelny at gmail.com, h.jagenteufel at gmail.com -- Stability : -- Portability : -- -- | -- ----------------------------------------------------------------------------- module VCSGui.Mercurial.Commit ( showCommitGUI ) where import Control.Monad.Trans(liftIO) import Control.Monad.Reader(ask) import Graphics.UI.Gtk import VCSGui.Common.GtkHelper import qualified VCSGui.Common.Commit as Commit import qualified VCSWrapper.Mercurial as Mercurial import qualified VCSWrapper.Common as Wrapper doCommit :: String -> [FilePath] -> [Commit.Option] -> Wrapper.Ctx () doCommit commitMsg files _ = do Mercurial.addremove files Mercurial.commit files commitMsg [] {- | Calls 'Commit.showCommitGUI' with a 'Graphics.UI.Gtk.ListStore' and 'OkCallBack' setup for Mercurial. This will display a window to enter a commit message and select the files to be commited by this commit. -} showCommitGUI :: Mercurial.Ctx () showCommitGUI = do Commit.showCommitGUI setupListStore doCommit --TODO this is copy&pasted from git implementation refactor it and use abstract version setupListStore :: TreeView -> Wrapper.Ctx (ListStore Commit.SCFile) setupListStore view = do repoStatus <- Mercurial.status --GITSCFile Bool FilePath String let selectedF = [Commit.GITSCFile True fp (show mod) | (Wrapper.GITStatus fp mod) <- repoStatus, mod == Wrapper.Modified || mod == Wrapper.Added] notSelectedF = [Commit.GITSCFile False fp (show mod) | (Wrapper.GITStatus fp mod) <- repoStatus, mod /= Wrapper.Modified && mod /= Wrapper.Added] liftIO $ do store <- listStoreNew (selectedF ++ notSelectedF) treeViewSetModel view store let item = (store, view) toggleRenderer <- cellRendererToggleNew addColumnToTreeView' item toggleRenderer "Commit" (\(Commit.GITSCFile s _ _)-> [cellToggleActive := s]) addTextColumnToTreeView' item "File" (\(Commit.GITSCFile _ p _) -> [cellText := p]) addTextColumnToTreeView' item "File status" (\(Commit.GITSCFile _ _ m) -> [cellText := m]) -- register toggle renderer on toggleRenderer cellToggled $ \filepath -> do putStrLn ("toggle called: " ++ filepath) Just treeIter <- treeModelGetIterFromString store filepath value <- listStoreGetValue store $ listStoreIterToIndex treeIter let newValue = (\(Commit.GITSCFile b fp m) -> Commit.GITSCFile (not b) fp m) value listStoreSetValue store (listStoreIterToIndex treeIter) newValue return () return store