{- Main Browser. Copyright (C) 2007, 2008 Luis Francisco Araujo 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) buttonIconList :: [(String, String)] buttonIconList = [ ("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") , ("add", "Add selected package to the processing queue") , ("remove", "Remove a selected package from the queue") , ("clear", "Clear the main package queue") , ("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)") , ("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") , ("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, addqueuebutton, removequeuebutton , clearqueuebutton, worldbutton, neworldbutton, syncbutton , emergebutton, unmergebutton, binarybutton, usepkgbutton , fetchbutton, systembutton, allbutton ] <- mapM (toolButton tooltips buttonstoolbar) buttonIconList -- 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 ("" ++ portagerepo ++ "") 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 -- 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))) -- Update package specific information views. versiontv `onCursorChanged` (updateInfo portagerepo versiontv (ebuildview, clogview) statbar >> updateMozillaFromQueue versiontv mozwindow 1) -- Package popup menu. versiontv `onButtonRelease` packagePopupMenu portagerepo versiontv statbar -- 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 addqueuebutton `onToolButtonClicked` addAtQueue versiontv processpanel statbar removequeuebutton `onToolButtonClicked` removePageElement processpanel clearqueuebutton `onToolButtonClicked` clearQueue processpanel statbar 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 [] addAtQueue :: TreeView -> Notebook -> Statusbar -> IO () addAtQueue fromtv panel statbar = isCurrentPagePackagePanel panel func where func totv = do [(fromstore, sel), (tostore,_)] <- storeAndSelector [fromtv, totv] maybeiter <- treeSelectionGetSelected sel case maybeiter of Nothing -> updateStatBar statbar "No package version selected." (Just node) -> do catpkg <- getCategoryPackage fromtv fromstore node updateStatBar statbar (catpkg ++ " added to queue.") pixbuf <- pixbufNewFromFile ebuildicon storeQueueObjects tostore pixbuf [("A", catpkg)] clearQueue :: Notebook -> Statusbar -> IO () {- | Removed all the packages in the queue if any. -} clearQueue panel statbar = isCurrentPagePackagePanel panel (\ pkgtv -> getStoreFromView pkgtv >>= listStoreClear >> updateStatBar statbar "Cleared package queue.") 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.")