himerge-0.20: src/Browser.hs
{-
Main Browser.
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 Browser
where
import Emerge
import Menus
import Util
import Web
import Render
import Graphics.UI.Gtk
import System.Directory
import Control.Monad
import Control.Concurrent
import Data.List
import Data.Char (isAlpha, isNumber)
import Data.Maybe
import System.Exit
import qualified Control.Exception as E
import System.IO
import System.Process
import Graphics.UI.Gtk.MozEmbed
-- | Browser type.
type Browser = (VBox, Notebook, TextView, Statusbar,
ProgressBar, MozEmbed, Tooltips)
queueButtons :: [(String, String)]
queueButtons =
[ ("queue", "Calculate the dependencies for a selected package and add them into the package queue")
, ("revdep", "Calculate the direct reverse dependencies for a selected package and add them into the package queue")
]
treeButtons :: [(String, String)]
treeButtons =
[ ("world", "Calculate the world dependencies and add them into the main package queue")
, ("neworld", "Calculate the world dependencies with the 'newuse' flag enabled and add them into the main package queue")
, ("sync", "Synchronize the portage tree with the remote repositories (sync)")
]
emergeButtons :: [(String, String)]
emergeButtons =
[ ("emerge", "Install the packages listed on the queue")
, ("unmerge", "Uninstall the packages listed on the queue")
, ("binary", "Install and make binary tarballs from the package listed on the queue")
, ("usepkg", "Install and use binary tarballs (if available) from the packages listed on the queue")
, ("fetch", "Only fetch the packages listed on the queue. Do not install them")
]
extraButtons :: [(String, String)]
extraButtons =
[ ("system", "Caculate the 'system' packages and add them into the queue")
, ("all", "List all packages installed in the system into the queue")
]
browserIcon :: [(String, String)]
browserIcon = [ ("refresh", "Refresh the browser view")
, ("edit", "Edit the browser view") ]
cquestions :: [String]
cquestions = [ "Do you want to install queded packages?"
, "Do you want to un-install queded packages?"
, "Do you want to install and build binary tarballs for queded packages?"
, "Do you want to install queded packages?\n(using available binary tarballs)"
, "Do you only want to fetch queded packages?"
]
portageBrowser :: FilePath -> IO Browser
portageBrowser prepo =
do
timeoutAddFull (yield >> return True) priorityDefaultIdle 50
let portagerepo = prepo ++ "/"
-- This is the main vertical box containing
-- all the widgets.
mainvbox <- vBoxNew False 3
browservbox <- vBoxNew False 3
-- Logo.
image <- imageNewFromFile windowlogo
-- Let's use ToolBars for the buttons.
buttonstoolbar <- toolbarNew
tooltips <- tooltipsNew
toolbarSetTooltips buttonstoolbar True
[ queuebutton , revdepbutton ]
<- mapM (toolButton tooltips buttonstoolbar) queueButtons
sep1 <- separatorToolItemNew
toolbarInsert buttonstoolbar sep1 (-1)
[ worldbutton, neworldbutton, syncbutton ]
<- mapM (toolButton tooltips buttonstoolbar) treeButtons
sep2 <- separatorToolItemNew
toolbarInsert buttonstoolbar sep2 (-1)
[ emergebutton, unmergebutton, binarybutton, usepkgbutton, fetchbutton ]
<- mapM (toolButton tooltips buttonstoolbar) emergeButtons
sep3 <- separatorToolItemNew
toolbarInsert buttonstoolbar sep3 (-1)
[ systembutton, allbutton ]
<- mapM (toolButton tooltips buttonstoolbar) extraButtons
mapM_ (flip separatorToolItemSetDraw True) [ sep1 , sep2, sep3 ]
-- eix entry text search.
checkbox <- checkButtonNew
searchbox <- comboBoxEntryNewText
searchlabel <- imageNewFromFile searchicon
searchbutton <- buttonNew
containerAdd searchbutton searchlabel
-- Tell what some of these options do.
tooltipsSetTip tooltips checkbox "Search package matching exact name" []
tooltipsSetTip tooltips searchbutton "Search package" []
labelsearchbox <- hBoxNew False 5
opt <- labelNew Nothing
labelSetMarkup opt ("<i><u>" ++ portagerepo ++ "</u></i>")
boxPackStart labelsearchbox image PackNatural 0
boxPackStart labelsearchbox opt PackNatural 0
boxPackEnd labelsearchbox checkbox PackNatural 0
boxPackEnd labelsearchbox searchbutton PackNatural 0
boxPackEnd labelsearchbox searchbox PackNatural 0
boxPackStart browservbox labelsearchbox PackNatural 0
-- Add the main toolbar with toolbuttons to the window.
boxPackStart browservbox buttonstoolbar PackNatural 5
-- Browser Start.
-- Add he Portage Command options to the browser.
expander <- expanderNew "Portage Browser Operations"
boxPackStart browservbox expander PackNatural 0
{- | Start adding the Portage Tree Views.
Get the portage tree root contents. -}
portagetree <- (getDirectory portagerepo >>= return . filterDirs removeddirs . removeOddDirs)
-- initialize all three liststore.
(categorytv, categoryscroll, _) <- createStore "Category" SelectionSingle False
(Just (categoryicon, portagetree))
(packagetv, packagescroll, _) <- createStore "Package" SelectionSingle False Nothing
(versiontv, versionscroll, _) <- createStore "Version" SelectionSingle False Nothing
-- Portage tree view main box.
viewbrowser <- hBoxNew False 0
mapM_ (flip (flip (boxPackStart viewbrowser) PackGrow) 3)
[categoryscroll, packagescroll, versionscroll]
containerSetBorderWidth viewbrowser 5
-- Create a frame around the whole browser: (text, scroll).
treeframe <- makeFrame "Portage Browser" 0.50 0.50
containerAdd treeframe viewbrowser
boxPackStart browservbox treeframe PackGrow 0
-- Browser Options.
-- This is the control panel containing the browser view options.
browsertoolbar <- toolbarNew
[ refreshbutton , showeditbutton ]
<- mapM (toolButton tooltips browsertoolbar) browserIcon
containerAdd expander browsertoolbar
-- Editable Text Browser.
-- This allows to do extra things like for example
-- removing un-existing packages on the package tree.
-- It also allows to edit the browser view entries.
editbrowser <- hBoxNew False 3
browsertext <- entryNew
-- Radio buttons to choose what scroll panel to edit.
rcategory <- radioButtonNewWithLabel "category"
rpackage <- radioButtonNewWithLabelFromWidget rcategory "package"
rversion <- radioButtonNewWithLabelFromWidget rcategory "version"
let radiolist = [(rcategory, "category"), (rpackage, "package"), (rversion, "version")]
let treeviewlist = [categorytv, packagetv, versiontv]
-- Add/Remove buttons.
addtobrowser <- buttonNewFromStock stockAdd
removefrombrowser <- buttonNewFromStock stockRemove
closeeditbrowser <- buttonNewFromStock stockClose
-- Say what these buttons do.
tooltipsSetTip tooltips addtobrowser "Add element to the specified browser category." []
tooltipsSetTip tooltips removefrombrowser "Remove selected element from its browser category." []
tooltipsSetTip tooltips closeeditbrowser "Close the edit browser options." []
-- Build the Editable Text Browser.
boxPackStart editbrowser browsertext PackGrow 3
boxPackStart editbrowser rcategory PackNatural 1
boxPackStart editbrowser rpackage PackNatural 1
boxPackStart editbrowser rversion PackNatural 1
-- button box.
radiobuttons <- hBoxNew True 0
boxPackStart radiobuttons addtobrowser PackNatural 0
boxPackStart radiobuttons removefrombrowser PackNatural 0
boxPackStart radiobuttons closeeditbrowser PackNatural 0
boxPackStart editbrowser radiobuttons PackNatural 3
editbrowserframe <- makeFrame "Browser Editor" 0.50 0.50
containerAdd editbrowserframe editbrowser
-- Connect buttons.
addtobrowser `onClicked` addToBrowserView radiolist treeviewlist browsertext
removefrombrowser `onClicked` removeFromBrowserView radiolist treeviewlist
closeeditbrowser `onClicked`
(containerRemove expander editbrowserframe >>
containerAdd expander browsertoolbar >>
widgetShowAll browservbox)
-- Browser Options.
showeditbutton `onToolButtonClicked`
(containerRemove expander browsertoolbar >>
containerAdd expander editbrowserframe >>
widgetShowAll browservbox)
refreshbutton `onToolButtonClicked`
refreshBrowser portagerepo categorytv packagetv versiontv
-- Browser End.
-- Let's use paneds to allow widgets to be resized.
-- Vertical paned.
vpaned <- vPanedNew
-- Horizontal paned.
hpaned <- hPanedNew
panedSetPosition hpaned 390
-- Makes the browser box resizable.
panedPack1 vpaned browservbox True True
-- Start creating the notebook panel.
processpanel <- notebookNew
notebookSetScrollable processpanel True
notebookSetPopup processpanel True
-- Different boxes containing the information windows
-- for the notebook pages.
(mozbox, mozwindow) <- webBrowser
-- Load the initial documentation.
mozEmbedLoadUrl mozwindow hdoc
-- Package mozilla browser.
panedPack1 hpaned mozbox True True
(logscroll, logview) <- makeView False
(ebuildscroll, ebuildview) <- makeView True
(clogscroll, clogview) <- makeView False
(pkgqueuetv, pkgqueuescroll) <- createQueueStore
-- Set the name of this widget to make it accessible to the
-- 'queue' operations.
widgetSetName pkgqueuescroll "scrollview"
widgetSetName pkgqueuetv "treeview"
-- Notebook pages.
-- Log view.
notebookAppendPage processpanel logscroll "Log"
notebookSetMenuLabelText processpanel logscroll "Log"
-- Queue package window.
notebookAppendPage processpanel pkgqueuescroll "Main Queue"
notebookSetMenuLabelText processpanel pkgqueuescroll "Main Queue"
-- Ebuild text window.
notebookAppendPage processpanel ebuildscroll "Ebuild"
notebookSetMenuLabelText processpanel ebuildscroll "Ebuild"
-- ChangeLog text window.
notebookAppendPage processpanel clogscroll "Changelog"
notebookSetMenuLabelText processpanel clogscroll "ChangeLog"
-- Add the notebook panel into a frame
controlframe <- makeFrame "Control Panel" 0.0 0.50
containerSetBorderWidth processpanel 5
containerAdd controlframe processpanel
-- Add the controlframe into the horizontal paned.
panedPack2 hpaned controlframe True False
-- Packs the horizontal paned inside the vertical one.
-- This allows resizing both the browser box and the info/mozilla widgets.
panedPack2 vpaned hpaned True False
-- Add the vertical paned to the main box.
boxPackStart mainvbox vpaned PackGrow 0
-- Build the status display box.
statusbox <- hBoxNew False 0
progbar <- progressBarNew
statbar <- statusbarNew
updateStatBar statbar "Welcome to himerge!"
boxPackStart statusbox statbar PackGrow 0
boxPackEnd statusbox progbar PackNatural 0
-- Add the last box into the main box.
boxPackStart mainvbox statusbox PackNatural 0
-- Search the package using eix.
searchbutton `onClicked` comboBoxSearchEntry searchbox
(search portagerepo packagetv categorytv versiontv statbar checkbox mozwindow)
searchbox `onKeyRelease` comboBoxSearchEntryEvent searchbox
(search portagerepo packagetv categorytv versiontv statbar checkbox mozwindow)
-- Update the category view.
categorytv `onCursorChanged`
updateCategory packageicon portagerepo categorytv packagetv
categorytv `onRowActivated`
(\ _ _ -> updateCategory packageicon portagerepo categorytv packagetv)
-- Update the package version view and information mozilla browser.
packagetv `onCursorChanged`
(updatePackage ebuildicon portagerepo packagetv versiontv >>=
(\ pkgname -> do
(Just tvc) <- treeViewGetColumn packagetv 0
(Just cat) <- treeViewColumnGetTitle tvc
updateMozilla mozwindow (" -e " ++ cat ++ "/" ++ pkgname)))
packagetv `onRowActivated`
(\ _ _ ->
updatePackage ebuildicon portagerepo packagetv versiontv >>=
(\ pkgname -> do
(Just tvc) <- treeViewGetColumn packagetv 0
(Just cat) <- treeViewColumnGetTitle tvc
updateMozilla mozwindow (" -e " ++ cat ++ "/" ++ pkgname)))
-- Update package specific information views.
versiontv `onCursorChanged`
(updateInfo portagerepo versiontv (ebuildview, clogview) statbar >>
updateMozillaFromQueue versiontv mozwindow 1)
versiontv `onRowActivated`
(\ _ _ ->
updateInfo portagerepo versiontv (ebuildview, clogview) statbar >>
updateMozillaFromQueue versiontv mozwindow 1)
-- Package popup menu.
versiontv `onButtonRelease` packagePopupMenu portagerepo versiontv statbar (addAtQueue versiontv processpanel)
-- Update the mozilla browser when selected a package from the Main Queue.
pkgqueuetv `onCursorChanged` (updateMozillaFromQueue pkgqueuetv mozwindow 3)
-- Queue operations.
queuebutton `onToolButtonClicked` pkgDependency versiontv processpanel logview statbar mozwindow progbar
revdepbutton `onToolButtonClicked` pkgReverseDependency versiontv processpanel logview statbar mozwindow progbar
worldbutton `onToolButtonClicked`
(writeLog logview msgworld >>
emergeQueue "--deep --update world" msgworld processpanel logview statbar mozwindow progbar)
neworldbutton `onToolButtonClicked`
(writeLog logview msgworldnewuse >>
emergeQueue "--newuse --deep --update world" msgworldnewuse processpanel logview statbar mozwindow progbar)
systembutton `onToolButtonClicked`
(writeLog logview msgsystem >>
emergeQueue "--newuse --deep --update system" msgsystem processpanel logview statbar mozwindow progbar)
allbutton `onToolButtonClicked`
(writeLog logview msginstalled >> pkgInstalled processpanel logview msginstalled statbar mozwindow progbar)
-- Main emerge operations.
syncbutton `onToolButtonClicked` sync processpanel logview statbar progbar
emergebutton `onToolButtonClicked`
popSelectWindow (cquestions !! 0) (emergePackages processpanel logview statbar progbar)
unmergebutton `onToolButtonClicked`
popSelectWindow (cquestions !! 1) (unmergePackages processpanel logview statbar progbar)
binarybutton `onToolButtonClicked`
popSelectWindow (cquestions !! 2) (binaryPackages processpanel logview statbar progbar)
usepkgbutton `onToolButtonClicked`
popSelectWindow (cquestions !! 3) (useBinaryPackages processpanel logview statbar progbar)
fetchbutton `onToolButtonClicked`
popSelectWindow (cquestions !! 4) (fetchPackages processpanel logview statbar progbar)
-- return this main vbox.
return (mainvbox, processpanel, logview, statbar, progbar, mozwindow, tooltips)
where
msgworld = "Calculating world dependencies."
msgworldnewuse = "Calculating world dependencies (newuse)."
msgsystem = "Calculating system dependencies."
msginstalled = "Calculating installed packages."
addToBrowserView :: [(RadioButton, String)] -> [TreeView] -> Entry -> IO ()
addToBrowserView radiolist tvs combotext =
do
t <- entryGetText combotext
case words t of
[] -> return ()
(text:_) -> do
option <- findRadioButton radiolist
let (icon, tv) = case option of
"category" -> (categoryicon, tvs !! 0)
"package" -> (packageicon, tvs !! 1)
"version" -> (ebuildicon, tvs !! 2)
_ -> error "addToBrowserView: This shouldn't ever happen!"
[(store,_)] <- storeAndSelector [tv]
storeObjects store icon [text]
removeFromBrowserView :: [(RadioButton, String)] -> [TreeView] -> IO ()
removeFromBrowserView radiolist tvs =
do
option <- findRadioButton radiolist
let tv = case option of
"category" -> tvs !! 0
"package" -> tvs !! 1
"version" -> tvs !! 2
_ -> error "removeFromBrowserView: This shouldn't ever happen!"
removeSelectedPkg tv
removeSelectedPkg :: TreeView -> IO ()
removeSelectedPkg tv =
do
[(store, sel)] <- storeAndSelector [tv]
maybeiter <- treeSelectionGetSelected sel
case maybeiter of
Nothing -> return ()
Just node -> do
(GVstring (Just name)) <- treeModelGetValue store node textColumn
popSelectWindow ("WARNING: Do you really want to remove [" ++ name ++ "] ?")
(listStoreRemove store node >> return ())
refreshBrowser :: FilePath -> TreeView -> TreeView -> TreeView -> IO ()
refreshBrowser repo category package version =
do
dirs <- getDirectory repo >>= return . filterDirs removeddirs . removeOddDirs
[(cat,_), (pkg,_), (ver,_)] <- storeAndSelector [category, package, version]
mapM_ listStoreClear [cat, pkg, ver]
storeObjects cat categoryicon dirs
iter <- treeModelGetIter cat [0]
case iter of
Nothing -> popErrorWindow "refreshBrowser: No value to scroll to?"
Just iter' -> scrollViewToCell cat iter' category
getSelectedPkg :: TreeView -> IO (Maybe String)
{- | Get the package name from a tree view (fromtv). -}
getSelectedPkg fromtv =
do
[(fromstore, sel)] <- storeAndSelector [fromtv]
maybeiter <- treeSelectionGetSelected sel
case maybeiter of
Nothing -> return Nothing
(Just node) -> getCategoryPackage fromtv fromstore node >>= (return . Just)
runForPkgQueue :: TreeView -> TextView -> (String -> String -> IO ())
-> Statusbar -> String -> IO ()
runForPkgQueue fromtv logview func statbar extramsg =
do
selectedpkg <- getSelectedPkg fromtv
case selectedpkg of
Nothing -> updateStatBar statbar "No package version selected."
(Just pkg) -> -- =cat/pkg-ver
do
let loginfo = ("Calculating" ++ extramsg ++ " dependencies for " ++ pkg)
-- Write operation log.
writeLog logview loginfo
func ("=" ++ pkg) loginfo
makeQueueFromCommand :: String -> String -> (Handle -> IO [(String, String)]) -> String
-> Notebook -> TextView -> Statusbar -> ProgressBar -> MozEmbed -> String -> IO ()
{- | Apply a command over a package name and gets its output into
the package Queue. -}
makeQueueFromCommand command statmsg func pkgtoken panel logview statbar progbar mozwindow extramsg =
do
(_,out,err,ph) <- runInteractiveCommand command
barthread <- forkIO $ updateBar progbar
nout <- E.evaluate out
statid <- forkIO $ refreshStatBar statbar statmsg
forkIO $ onExit ph ((.) ((>>) (killThread statid)) (handleExitCode nout err barthread))
return ()
where
handleExitCode handle errhandle barthread exitcode =
killThread barthread >>
case exitcode of
ExitSuccess -> do
let pkg = last $ words pkgtoken
pkglist <- func handle
case pkglist of
[] -> do
let rlog = ("No valid dependencies for " ++ pkg)
writeLog logview rlog
updateStatBar statbar rlog
progressBarSetFraction progbar 0.0
pkglist' -> do
-- Make a new Queue for each process.
(pkgqueuetv, pkgqueuescroll) <- createQueueStore
-- Name this widget to keep track of the correct package values.
widgetSetName pkgqueuetv "treeview"
widgetSetName pkgqueuescroll "scrollview"
-- Build the panel page.
(tooltips, _, (Just closebutton))
<- buildPanelTab pkgqueuescroll panel ("Queue: " ++ pkgtoken) CloseButton
widgetShowAll pkgqueuescroll
notebookSetCurrentPage panel (-1)
-- Connect this button to the close signal.
(Just text) <- notebookGetMenuLabelText panel pkgqueuescroll
closebutton `onClicked`
(popSelectWindow ("Do you really want to close [" ++ text ++ "]?")
(tooltipsEnable tooltips >> closeTab panel pkgqueuescroll))
-- Update mozilla browser when selecting a package from the queue.
pkgqueuetv `onCursorChanged` (updateMozillaFromQueue pkgqueuetv mozwindow 3)
depst <- getStoreFromView pkgqueuetv
listStoreClear depst
-- Add packages into the queue.
pixbuf <- pixbufNewFromFile ebuildicon
storeQueueObjects depst pixbuf pkglist'
let rlog = (pkg ++ extramsg ++ " dependencies successfully calculated.")
writeLog logview rlog
updateStatBar statbar rlog
progressBarSetFraction progbar 1.0
_ -> do
hGetContents errhandle >>= hPutStr stderr
let rlog = ("Error calculating package" ++ extramsg ++ " dependencies.")
writeLog logview rlog
emergeError rlog handle
updateStatBar statbar rlog
progressBarSetFraction progbar 0.0
emergeQueue :: String -> String -> Notebook -> TextView
-> Statusbar -> MozEmbed -> ProgressBar -> IO ()
emergeQueue pkgtoken statmsg panel logview statbar mozwindow progbar =
makeQueueFromCommand (emergepath ++ " --verbose --pretend " ++ pkgtoken)
statmsg emergeDeps pkgtoken panel logview statbar progbar mozwindow []
pkgDependency :: TreeView -> Notebook -> TextView
-> Statusbar -> MozEmbed -> ProgressBar -> IO ()
{- | Calculate the dependency queue of a package. -}
pkgDependency fromtv panel logview statbar mozwindow progbar =
runForPkgQueue fromtv logview func statbar []
where
func pkgtoken statmsg =
makeQueueFromCommand (emergepath ++ " --verbose --pretend " ++ pkgtoken) statmsg
emergeDeps pkgtoken panel logview statbar progbar mozwindow []
pkgReverseDependency :: TreeView -> Notebook -> TextView
-> Statusbar -> MozEmbed -> ProgressBar -> IO ()
{- | Calculte the reverse dependency queue of a package. -}
pkgReverseDependency fromtv panel logview statbar mozwindow progbar =
runForPkgQueue fromtv logview func statbar " reverse"
where
func pkgtoken statmsg =
makeQueueFromCommand (equerypath ++ "depends " ++ pkgtoken) statmsg
equeryOutput pkgtoken panel logview statbar progbar mozwindow " reverse"
pkgInstalled :: Notebook -> TextView -> String -> Statusbar -> MozEmbed -> ProgressBar -> IO ()
pkgInstalled panel logview statmsg statbar mozwindow progbar =
makeQueueFromCommand (qlistpath ++ "--verbose --nocolor --installed") statmsg
equeryOutput "all-packages" panel logview statbar progbar mozwindow []
updateCategory :: FilePath -> FilePath -> TreeView
-> TreeView -> IO ()
{- | Update the packages views with the category
information available. -}
updateCategory image repopath tv newtv =
do
[(store, sel), (newstore, _)] <- storeAndSelector [tv, newtv]
rows <- treeSelectionGetSelectedRows sel
case rows of
[[node]] -> do
(GVstring (Just catname)) <- valueWithIterTreeModel store node textColumn
let directory = (repopath ++ catname ++ "/")
dirb <- doesDirectoryExist directory
if dirb
then do
dir <- getDirectory directory
initStoringObj newtv newstore catname image dir
iter <- treeModelGetIter newstore [0]
if isJust iter
then scrollViewToCell newstore (fromJust iter) newtv
else popErrorWindow "No valid category."
else popErrorWindow (directory ++ " does not exist.")
_ -> return ()
updatePackage :: FilePath -> FilePath -> TreeView -> TreeView -> IO String
{- | Update the package versions views with the package
information available. -}
updatePackage image repopath tv newtv =
do
[(store, sel), (newstore, _)] <- storeAndSelector [tv, newtv]
rows <- treeSelectionGetSelectedRows sel
case rows of
[[node]] -> do
(GVstring (Just pkgname)) <- valueWithIterTreeModel store node textColumn
(Just tvc) <- treeViewGetColumn tv 0
(Just cat) <- treeViewColumnGetTitle tvc
let fullcatpkg = cat ++ "/" ++ pkgname
let directory = (repopath ++ fullcatpkg ++ "/")
dirb <- doesDirectoryExist directory
if dirb
then do
dir <- getVersion directory
initStoringObj newtv newstore fullcatpkg image dir
return pkgname
else popErrorWindow (fullcatpkg ++ " does not exist.") >> return []
_ -> return []
updateMozilla :: MozEmbed -> String -> IO ()
updateMozilla mozweb pkgname =
do
eix <- eixOutput pkgname
(tmpfile, tmphandle) <- writeTempFile htmltemp
hPutStr tmphandle $ render eix
hFlush tmphandle
mozEmbedLoadUrl mozweb tmpfile
removeFile tmpfile `E.catch`
\ e -> popErrorWindow $ show e
hClose tmphandle
updateMozillaFromQueue :: TreeView -> MozEmbed -> Int -> IO ()
updateMozillaFromQueue pkgtv mozwindow column =
do
[(store, sel)] <- storeAndSelector [pkgtv]
row <- treeSelectionGetSelectedRows sel
case row of
[[node]] -> do
(GVstring (Just pkginfo)) <- valueWithIterTreeModel store node column
let p = (extractpkg $ splitpkg $ takeWhile (/= ' ') pkginfo)
updateMozilla mozwindow (" -e " ++ p)
where
splitpkg = splitStr '-'
extractpkg spkg =
if (f $ last $ spkg)
then joinStr '-' $ init $ init spkg
else joinStr '-' $ init spkg
f ('r':xs) = all isNumber xs
f _ = False
_ -> return ()
updateInfo :: FilePath -> TreeView -> (TextView, TextView)
-> Statusbar -> IO ()
{- | Update the different panel views with the
version treeview information available. -}
updateInfo repopath tv (ebuildv, clogv) statbar =
do
[(store, sel)] <- storeAndSelector [tv]
rows <- treeSelectionGetSelectedRows sel
case rows of
[[n]] -> do
(Just tvc) <- treeViewGetColumn tv 0
(Just cat) <- treeViewColumnGetTitle tvc
(GVstring (Just package)) <- valueWithIterTreeModel store n textColumn
let parsedpath = repopath ++ cat ++ "/"
let changelogpath = parsedpath ++ "ChangeLog"
let ebuildpath = parsedpath ++ package ++ ".ebuild"
-- Test for the ebuild (just in case) and Changelog file existence.
[ebuild, changelog] <-
mapM (\ (file, msg) -> do
b <- doesFileExist file
if b then readFile file else return msg)
[ (ebuildpath, "No ebuild file!!!.")
, (changelogpath, "No Changelog file available.") ]
updateTextBuffer ebuildv ebuild
updateTextBuffer clogv changelog
_ -> updateStatBar statbar "Incorrect option."
initStoringObj :: TreeView -> ListStore -> FilePath -> FilePath
-> [FilePath] -> IO ()
{- Add new objects to a tree store.
Used for updating the category and package treeviews. -}
initStoringObj tv newstore pkgorcatname image dir =
do
listStoreClear newstore
(Just tvc) <- treeViewGetColumn tv 0
treeViewColumnSetTitle tvc pkgorcatname
storeObjects newstore image dir
return ()
comboBoxSearchEntryEvent :: ComboBoxEntry -> (String -> String -> IO ())
-> Event -> IO Bool
comboBoxSearchEntryEvent sbox func (Key { eventKeyName = "Return" }) =
comboBoxSearchEntry sbox func >> return True
comboBoxSearchEntryEvent _ _ _ = return False
comboBoxSearchEntry :: ComboBoxEntry -> (String -> String -> IO ()) -> IO ()
{- Entry function for the package search box operation. -}
comboBoxSearchEntry sbox func =
do
text <- comboBoxGetActiveText sbox
case text of
Nothing -> return ()
Just [] -> return ()
Just jtext | null $ words jtext -> return ()
| otherwise -> do
model <- comboBoxGetModel sbox
let textval = stripspaces jtext
case model of
Nothing -> return ()
Just m -> comboboxgetstrings m >>=
\ s -> if any (== textval) s
then return ()
else comboBoxPrependText sbox textval
out <- eixOutput textval
forkIO $ (func textval out >> return ())
return ()
where
comboboxgetstrings model' = collectIters model' 0 >>= collectStringValues model' 0
stripspaces = unwords . words
search :: FilePath -> TreeView -> TreeView -> TreeView
-> Statusbar -> CheckButton -> MozEmbed -> String -> String -> IO ()
search repopath pkgtv cattv vertv statbar checkb mozwindow pkgname eixoutput =
do
cb <- toggleButtonGetActive checkb
let parsed = parseEixOutput pkgname cb eixoutput
if null (fst parsed)
then updateStatBar statbar ("Package " ++ pkgname ++ " not found.")
else searchOn pkgname repopath cattv pkgtv vertv parsed statbar cb mozwindow
parseEixOutput :: String -> Bool -> String -> ([String], [String])
{- Return structure of the form: ([categories], [packages]) -}
parseEixOutput pkgname cbool = findpkg pkgname (if cbool then (==) else findSubstring) [] []
. filter (\ c -> if (not . null) c then ((/= ' ') . (!! 0)) c else False)
. lines
where
findpkg _ _ cats pkgs [] = (nub (cats ++ []), nub (pkgs ++ []))
findpkg pkgname' func cats pkgs (ps:pss) =
-- Break at '/' for "* category/package"
if (not . any (== '/')) catpkg
then findpkg pkgname' func cats pkgs pss
else (if func pkgname' pkg || func pkgname' catpkg
then findpkg pkgname' func (cats ++ [cat]) (pkgs ++ [pkg]) pss
else findpkg pkgname' func cats pkgs pss)
where
stripr = takeWhile (/= ' ')
stripl = dropWhile (not . isAlpha)
catpkg = stripr $ stripl $ ps
(cat, (_:pkg)) = break (== '/') catpkg
searchOn :: String -> FilePath -> TreeView -> TreeView -> TreeView
-> ([String], [String]) -> Statusbar -> Bool -> MozEmbed -> IO ()
{- | Search the package on the views. -}
searchOn pkgname repopath cattv pkgtv vertv (cats, pkgs) statbar checkbool mozwindow =
do
[(catstore, catsel)] <- storeAndSelector [cattv]
generalfind findcat 0 catstore catsel "category" (cats, pkgs)
where
generalfind _ _ _ _ _ ([], []) = updateStatBar statbar "Package not found."
generalfind _ _ _ _ _ ([], _) = updateStatBar statbar "Package not found."
generalfind _ _ _ _ _ (_, []) = searchOn pkgname repopath cattv pkgtv vertv (tail cats, pkgs)
statbar checkbool mozwindow
generalfind func num store sel label (catss, pkgss) =
do
jiter <- treeModelGetIter store [num]
case jiter of
Nothing -> if label == "category"
then generalfind func 0 store sel label (tail catss, pkgss)
else generalfind func 0 store sel label (catss, tail pkgss)
Just iter ->
do
(GVstring (Just value)) <- treeModelGetValue store iter textColumn
let mvalue = if label == "category" then (head catss) else (head pkgss)
if (==) value mvalue
then func iter sel value store (catss, pkgss) >>
-- Exact query for eix if it is enabled the checkbutton.
case checkbool of { True -> return " -e " ; False -> return []} >>=
\ c -> updateMozilla mozwindow (c ++ pkgname)
else generalfind func (num + 1) store sel label (catss, pkgss)
findcat iter' sel' _ store' xs =
do
treeSelectionSelectIter sel' iter'
-- Scroll to the category found.
scrollViewToCell store' iter' cattv
updateCategory packageicon repopath cattv pkgtv
[(pkgstore, pkgsel)] <- storeAndSelector [pkgtv]
generalfind findpkg 0 pkgstore pkgsel "package" xs
findpkg iter' sel' value' store' _ =
do
treeSelectionSelectIter sel' iter'
-- Scroll to the package found.
scrollViewToCell store' iter' pkgtv
updatePackage ebuildicon repopath pkgtv vertv
updateStatBar statbar ("Package " ++ value' ++ " found.")