himerge-0.20: src/Main.hs
{-
Himerge: A simple Haskell GUI front-end for Portage.
This is the module implementing the entry functions
for hte program.
Copyright (C) 2007, 2008 Luis Francisco Araujo <araujo@gentoo.org>
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
-}
module Main (Main.main)
where
import Init
import Browser
import Menus
import Components
import Emerge
import UseFlag
import Util
import Graphics.UI.Gtk
import System.IO
import Control.Concurrent
import System.Directory (doesDirectoryExist)
import Graphics.UI.Gtk.MozEmbed
(MozEmbed, mozEmbedLoadUrl)
main :: IO ()
main = mainBrowser portageroot
mainBrowser :: FilePath -> IO ()
mainBrowser portagerepo =
do
initGUI
timeoutAddFull (yield >> return True) priorityDefaultIdle 50
-- Initialize Himerge.
initialize
-- Check for valid repository path.
b <- doesDirectoryExist portagerepo
if not b
then popErrorWindow "Repository doesn't exist."
else do
mainwindow <- windowNew
onDestroy mainwindow mainQuit
vbox <- vBoxNew False 0
-- portage browser.
(browser, infopanel, logview, statbar, progbar, mozwindow, tooltips)
<- portageBrowser portagerepo
-- menu bar.
menubar <- menu mainwindow infopanel logview mozwindow statbar progbar
-- build main widget.
boxPackStart vbox menubar PackNatural 0
boxPackStart vbox browser PackGrow 0
-- main widget.
set mainwindow [ windowTitle := "Himerge"
, windowDefaultWidth := 900
, windowDefaultHeight := 700
, containerChild := vbox
, containerBorderWidth := 5 ]
widgetShowAll mainwindow
let delmsg = "Are you sure you want to close this Himerge window?"
mainwindow `onDelete`
(\ _ -> popSelectWindow delmsg (widgetDestroy mainwindow) >>
return True)
mainwindow `onKeyPress` acceOpenNew
mainwindow `onKeyPress` acceOpenNewRepo
mainwindow `onKeyPress` acceUseFlag
mainwindow `onKeyPress` acceSaveCurrentPage infopanel
mainwindow `onKeyPress` acceSaveAllPages infopanel
mainwindow `onKeyPress` accePackagesBranch
mainwindow `onKeyPress` acceUpdateEix infopanel logview statbar progbar
mainwindow `onKeyPress` accePortageInfo infopanel logview statbar progbar
mainwindow `onKeyPress` acceMetadata infopanel logview statbar progbar
mainwindow `onKeyPress` acceHelp mozwindow
mainGUI
-- Enable tooltips.
-- Call this function at this point to avoid GC.
tooltipsEnable tooltips
uiLabel :: String
uiLabel =
"<ui>\
\ <menubar>\
\ <menu name=\"File\" action=\"FileAction\">\
\ <menuitem name=\"New\" action=\"NewAction\" />\
\ <menuitem name=\"New Repo\" action=\"NewRepoAction\" />\
\ <separator/>\
\ <menuitem name=\"Save Current Page\" action=\"SaveCurrentPageAction\" />\
\ <menuitem name=\"Save All Pages\" action=\"SaveAllPagesAction\" />\
\ <separator/>\
\ <menuitem name=\"Exit\" action=\"ExitAction\"/>\
\ <placeholder name=\"FileMenuAdditions\" />\
\ </menu>\
\ <menu name=\"Edit\" action=\"EditAction\">\
\ <menuitem name=\"Packages Branch\" action=\"PackagesBranch\"/>\
\ <menuitem name=\"Use Flags\" action=\"UseFlagAction\"/>\
\ </menu>\
\ <menu name=\"Tools\" action=\"ToolsAction\">\
\ <menuitem name=\"Update Eix\" action=\"UpdateEixAction\"/>\
\ <menuitem name=\"Info\" action=\"InfoAction\"/>\
\ <menuitem name=\"Metadata\" action=\"MetadataAction\"/>\
\ </menu>\
\ <menu name=\"Help\" action=\"HelpAction\">\
\ <menuitem name=\"Help\" action=\"HelpDocAction\"/>\
\ <menuitem name=\"About himerge\" action=\"AboutAction\"/>\
\ </menu>\
\ </menubar>\
\</ui>"
menu :: Window -> Notebook -> TextView -> MozEmbed
-> Statusbar -> ProgressBar -> IO Widget
menu window panel logview mozwindow statbar progbar =
do
-- Create the menus.
fileAct <- actionNew "FileAction" "File" Nothing Nothing
editAct <- actionNew "EditAction" "Edit" Nothing Nothing
toolsAct <- actionNew "ToolsAction" "Tools" Nothing Nothing
helpAct <- actionNew "HelpAction" "Help" Nothing Nothing
-- Create menu items.
-- File items.
newAct <- actionNew "NewAction" "New"
(Just "Clear the spreadsheet area.") (Just stockNew)
newAct `onActionActivate` main
newRepoAct <- actionNew "NewRepoAction" "New Repo"
(Just "Change portage repository.") (Just stockNew)
newRepoAct `onActionActivate` openRepository
saveCurrentPageAct <- actionNew "SaveCurrentPageAction" "Save Current Page"
(Just "Save current page contents.") (Just stockSaveAs)
saveCurrentPageAct `onActionActivate` savePage (pageContents panel)
saveAllPagesAct <- actionNew "SaveAllPagesAction" "Save All Pages"
(Just "Save all the panel pages.") (Just stockSaveAs)
saveAllPagesAct `onActionActivate` savePage (allPages panel)
exitAct <- actionNew "ExitAction" "Exit" (Just "Exit this application.")
(Just stockSaveAs)
exitAct `onActionActivate` widgetDestroy window
-- Edit items.
packagesBranchAct <- actionNew "PackagesBranch" "Packages Branch"
(Just "Show branch information.") (Just stockProperties)
packagesBranchAct `onActionActivate` packageBranch
useFlagsAct <- actionNew "UseFlagAction" "Use Flag Editor"
(Just "Edit use flags.") (Just stockProperties)
useFlagsAct `onActionActivate` (forkIO globalUseFlags >> return ())
-- Tools items.
updateEixAct <- actionNew "UpdateEixAction" "Update Eix"
(Just "Update the eix package database.") (Just stockExecute)
updateEixAct `onActionActivate` updateEix panel logview statbar progbar
infoAct <- actionNew "InfoAction" "Portage Info"
(Just "Show portage information.") (Just stockExecute)
infoAct `onActionActivate` emergeInfo panel logview statbar progbar
metadataAct <- actionNew "MetadataAction" "Metadata"
(Just "Regenerate portage metadata.") (Just stockExecute)
metadataAct `onActionActivate` emergeMetadata panel logview statbar progbar
-- Help items.
docAct <- actionNew "HelpDocAction" "Help" (Just "Help Documentation") (Just stockHelp)
docAct `onActionActivate` mozEmbedLoadUrl mozwindow hdoc
aboutAct <- actionNew "AboutAction" "About Himerge" (Just "About this tool.") (Just stockAbout)
aboutAct `onActionActivate` aboutHimerge
-- Add accelerators.
standardGroup <- actionGroupNew "standard"
mapM_ (actionGroupAddAction standardGroup) [fileAct, editAct, toolsAct, helpAct]
mapM_ (\ act -> actionGroupAddActionWithAccel standardGroup act Nothing)
[ newAct, exitAct, docAct, aboutAct ]
mapM_ (\ (act, acc) -> actionGroupAddActionWithAccel standardGroup act acc)
[ (newRepoAct, (Just "<Control>r"))
, (useFlagsAct, (Just "<Control>f"))
, (updateEixAct, (Just "<Control>u"))
, (metadataAct, (Just "<Control>m"))
, (infoAct, (Just "<Control>i"))
, (packagesBranchAct, (Just "<Control>b"))
, (saveCurrentPageAct, (Just "<Control>s"))
, (saveAllPagesAct, (Just "<Control>a")) ]
ui <- uiManagerNew
uiManagerAddUiFromString ui uiLabel
uiManagerInsertActionGroup ui standardGroup 0
(Just menuBar) <- uiManagerGetWidget ui "/ui/menubar"
return menuBar
{- | Accelerators code starts from here. -}
acceOpenNew, acceOpenNewRepo :: Event -> IO Bool
acceSaveCurrentPage, acceSaveAllPages
:: Notebook -> Event -> IO Bool
acceUseFlag, accePackagesBranch :: Event -> IO Bool
acceUpdateEix, accePortageInfo, acceMetadata
:: Notebook -> TextView -> Statusbar -> ProgressBar -> Event -> IO Bool
acceHelp :: MozEmbed -> Event -> IO Bool
acceHelp mozw (Key { eventModifier = [Control], eventKeyName = "h" }) =
mozEmbedLoadUrl mozw hdoc >> return True
acceHelp _ _ = return False
acceOpenNew (Key { eventModifier = [Control], eventKeyName = "n" }) =
main >> return True
acceOpenNew _ = return False
acceOpenNewRepo (Key { eventModifier = [Control], eventKeyName = "r" }) =
openRepository >> return True
acceOpenNewRepo _ = return False
acceSaveCurrentPage panel (Key { eventModifier = [Control], eventKeyName = "s" }) =
savePage (pageContents panel) >> return True
acceSaveCurrentPage _ _ = return False
acceSaveAllPages panel (Key { eventModifier = [Control], eventKeyName = "a" }) =
forkIO (savePage (allPages panel)) >> return True
acceSaveAllPages _ _ = return False
acceUpdateEix panel logview statbar progbar (Key { eventModifier = [Control]
, eventKeyName = "u" }) =
updateEix panel logview statbar progbar >> return True
acceUpdateEix _ _ _ _ _ = return False
accePortageInfo panel logview statbar progbar (Key { eventModifier = [Control]
, eventKeyName = "i" }) =
emergeInfo panel logview statbar progbar >> return True
accePortageInfo _ _ _ _ _ = return False
acceMetadata panel logview statbar progbar (Key { eventModifier = [Control]
, eventKeyName = "m" }) =
emergeMetadata panel logview statbar progbar >> return True
acceMetadata _ _ _ _ _ = return False
acceUseFlag (Key { eventModifier = [Control], eventKeyName = "f" }) =
forkIO globalUseFlags >> return True
acceUseFlag _ = return False
accePackagesBranch (Key { eventModifier = [Control], eventKeyName = "b" }) =
packageBranch >> return True
accePackagesBranch _ = return False
openRepository :: IO ()
{- | Open Repository dialog chooser. -}
openRepository = getChooser openCRepository fileChooserGetCurrentFolder
mainBrowser
openCRepository :: IO FileChooserDialog
openCRepository = fileChooserDialogNew (Just "himerge") Nothing
FileChooserActionSelectFolder
[("Ok", ResponseOk), ("Cancel", ResponseCancel)]
savePage :: (FilePath -> IO ()) -> IO ()
{- | Open Save File dialog chooser. -}
savePage = getChooser saveCPage fileChooserGetFilename
saveCPage :: IO FileChooserDialog
saveCPage =
do
fc <- fileChooserDialogNew (Just "himerge") Nothing FileChooserActionSave
[("Save", ResponseOk), ("Cancel", ResponseCancel)]
fileChooserSetDoOverwriteConfirmation fc True
fileChooserSetCurrentName fc "Untitled Document"
return fc