himerge-0.17.9: 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 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
-- 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 := 930
, windowDefaultHeight := 730
, 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