himerge 0.18 → 0.20
raw patch · 12 files changed
+211/−229 lines, 12 filesbinary-added
Files
- ChangeLog +13/−0
- data/himerge/doc/himerge_doc.html +2/−2
- data/himerge/icons/small-clear.png binary
- himerge.cabal +4/−2
- install_data.sh +17/−3
- readme.txt +2/−2
- src/Browser.hs +2/−32
- src/Init.hs +72/−0
- src/Main.hs +5/−2
- src/Menus.hs +27/−10
- src/UseFlag.hs +21/−172
- src/Util.hs +46/−4
ChangeLog view
@@ -1,5 +1,18 @@ Himerge -- Haskell Interface for Emerge +-- version 0.20 (May, 01, 2008)++ 1 - The queue operation 'add' is now available through a right-click from+ the browser version view for each package.+ 2 - The queue operations 'remove/clear' are now available from each of the+ control panel package queue through a right-click.+ 3 - A backup of all the system files used by himerge will be created inside+ the ~/.himerge/ directory.+ 4 - The USE flag browser is highly-improved. A new browser constrcution+ mechanism speeds up the launch of the browser and shows a more organized and+ coherent framework, listing only the necessary flags boxes available for a+ given entity (a package or the whole system use flags).+ -- version 0.18 (Apr, 01, 2008) 1 - USE flag browser improved. It now shows use flags classified
data/himerge/doc/himerge_doc.html view
@@ -3,13 +3,13 @@ <link title=\"new\" rel="stylesheet" href="himerge.css" type="text/css"> </head> <body>-<p class="newshead" lang="en"><b>Himerge 0.18</b></p>+<p class="newshead" lang="en"><b>Himerge 0.20</b></p> <ul> <li><strong>Himerge</strong></li> <p>Himerge is a graphical user interface for emerge (Gentoo's Portage system) written in Haskell using gtk2hs.</p> <p>The main idea is to simplify browsing the entire portage tree as well as of running the most basic and common options from the emerge command. Himerge also offers several handy tools, like global and local use flags browsers, pretty much inspired on UFED (Gentoo Linux USE flags editor). It also uses eix (Small utility for searching ebuilds with indexing for fast results) as a back-end command to show package information on html/css format, so you can access the package web-site for a quick-glance.</p> - <li><strong>Features on Himerge 0.18</strong></li>+ <li><strong>Features on Himerge 0.20</strong></li> <ol> <li>Access the whole portage tree using the 'Category', 'Package', 'Version' views.</li> <li>Category: List all the categories of the repository. This is /usr/portage by default, but you can specify a new one (overlays.)</li>
+ data/himerge/icons/small-clear.png view
binary file changed (absent → 786 bytes)
himerge.cabal view
@@ -1,5 +1,5 @@ Name: himerge-Version: 0.18+Version: 0.20 License: GPL License-File: LICENSE Author: Luis Francisco Araujo@@ -43,6 +43,7 @@ data/himerge/icons/search.png data/himerge/icons/small-add.png data/himerge/icons/small-remove.png+ data/himerge/icons/small-clear.png data/himerge/icons/sync.png data/himerge/icons/system.png data/himerge/icons/unmerge.png@@ -52,7 +53,8 @@ Executable: himerge Main-Is: Main.hs Hs-Source-Dirs: src-Other-Modules: +Other-Modules:+ Init, Browser, Components, Emerge,
install_data.sh view
@@ -1,7 +1,21 @@-# -# himerge 0.18+# Data install script for himerge 0.20.+# Copyright (C) 2007, 2008 Luis Francisco Araujo <araujo@gentoo.org> #-VERSION="0.18"+# 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++VERSION="0.20" HIMERGE_DATA="/usr/share/himerge" HIMERGE_DOC="/usr/share/doc/himerge-${VERSION}/" HIMERGE_ICONS="$HIMERGE_DATA/icons/"
readme.txt view
@@ -1,7 +1,7 @@ ------------------------------------------------------- Himerge: A Haskell Graphical User Interface for Emerge. --------------------------------------------------------Version: 0.18 (Himalaya)+Version: 0.20 (Mani Wheel) Status: Beta Dependencies:@@ -43,4 +43,4 @@ Luis Francisco Araujo araujo@gentoo.org -Sun Mar 30 22:08:49 VET 2008+Thu May 1 20:30:31 VET 2008
src/Browser.hs view
@@ -46,9 +46,6 @@ 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")- , ("add", "Add selected package to the processing queue")- , ("remove", "Remove a selected package from the queue")- , ("clear", "Clear the main package queue") ] treeButtons :: [(String, String)]@@ -100,8 +97,7 @@ buttonstoolbar <- toolbarNew tooltips <- tooltipsNew toolbarSetTooltips buttonstoolbar True- [ queuebutton , revdepbutton, addqueuebutton, removequeuebutton- , clearqueuebutton ]+ [ queuebutton , revdepbutton ] <- mapM (toolButton tooltips buttonstoolbar) queueButtons sep1 <- separatorToolItemNew toolbarInsert buttonstoolbar sep1 (-1)@@ -306,15 +302,12 @@ updateInfo portagerepo versiontv (ebuildview, clogview) statbar >> updateMozillaFromQueue versiontv mozwindow 1) -- Package popup menu.- versiontv `onButtonRelease` packagePopupMenu portagerepo versiontv statbar+ 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- 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)@@ -511,29 +504,6 @@ 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 ()
+ src/Init.hs view
@@ -0,0 +1,72 @@+{-+ Himerge initialization routines.+ 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 Init+ where++import Util+ (removeOddDirs, makeconfpath, packagekeywords,+ packagemask, packageuse)+import System.Directory++himergecfg :: FilePath+himergecfg = "/.himerge/"++himergeDir :: IO FilePath+himergeDir = getHomeDirectory >>= return . (++ himergecfg)++getDirname :: FilePath -> FilePath+getDirname = reverse . takeWhile (/= '/') . reverse++initialize :: IO ()+initialize = initDirectory++initDirectory :: IO ()+initDirectory =+ do+ cfgdir <- himergeDir+ createDirectoryIfMissing True cfgdir+ mapM_ backUpFiles [makeconfpath, packagekeywords+ , packagemask, packageuse]++backUpFiles :: FilePath -> IO ()+backUpFiles filepath =+ do+ isfile <- doesFileExist filepath+ case isfile of+ True -> himergeDir >>= copyFile filepath . (++ (getDirname filepath))+ False -> + do+ isdir <- doesDirectoryExist filepath+ case isdir of+ True -> himergeDir >>= return . (++ (getDirname filepath)) >>= + makeCFGDirectory filepath+ False -> return ()++makeCFGDirectory :: FilePath -> FilePath -> IO ()+makeCFGDirectory destdir newdir =+ do+ createDirectoryIfMissing True newdir+ contents <- getDirectoryContents destdir+ mapM_ (\ f -> do+ let dir = destdir ++ "/" ++ f+ isdir <- doesDirectoryExist f+ case isdir of+ True -> makeCFGDirectory dir (newdir ++ "/" ++ f)+ False -> copyFile dir (newdir ++ "/" ++ f)) (removeOddDirs contents)
src/Main.hs view
@@ -22,6 +22,7 @@ module Main (Main.main) where +import Init import Browser import Menus import Components@@ -43,6 +44,8 @@ do initGUI timeoutAddFull (yield >> return True) priorityDefaultIdle 50+ -- Initialize Himerge.+ initialize -- Check for valid repository path. b <- doesDirectoryExist portagerepo if not b @@ -61,8 +64,8 @@ boxPackStart vbox browser PackGrow 0 -- main widget. set mainwindow [ windowTitle := "Himerge"- , windowDefaultWidth := 930- , windowDefaultHeight := 730+ , windowDefaultWidth := 900+ , windowDefaultHeight := 700 , containerChild := vbox , containerBorderWidth := 5 ] widgetShowAll mainwindow
src/Menus.hs view
@@ -148,18 +148,25 @@ {- | Code for windows showing different menus. pop-up menu for packages versions and the package branch editor.-} -packagePopupMenu :: FilePath -> TreeView -> Statusbar -> Event -> IO Bool+packagePopupMenu :: FilePath -> TreeView -> Statusbar + -> (Statusbar -> IO ()) -> Event -> IO Bool {- | Package versions popup menu. -}-packagePopupMenu prepo tv statbar event@(Button { eventClick = ReleaseClick- , eventButton = RightButton }) = - getPackage prepo tv >>= flip packageMenuItems statbar >>= - flip menuPopup (Just (eventButton event, eventTime event)) >> return True-packagePopupMenu _ _ _ _ = return False+packagePopupMenu prepo tv statbar addatqueuefunc event@(Button { eventClick = ReleaseClick+ , eventButton = RightButton }) =+ getPackage prepo tv >>= flip (packageMenuItems addatqueuefunc) statbar >>=+ flip menuPopup (Just (eventButton event, eventTime event)) >> return True+packagePopupMenu _ _ _ _ _ = return False -packageMenuItems :: (String, String, String, String) -> Statusbar -> IO Menu-packageMenuItems (ebuildpath, catpkg, pkg, key) statbar =+packageMenuItems :: (Statusbar -> IO ()) -> (String, String, String, String) + -> Statusbar -> IO Menu+packageMenuItems addatqueuefunc (ebuildpath, catpkg, pkg, key) statbar = do pkgmenu <- menuNew+ -- Add-at-queue operation.+ addqueue <- imageMenuItemNewWithLabel ("add at queue " ++ pkg)+ addqueueicon <- imageNewFromFile (iconpath ++ "small-add.png")+ imageMenuItemSetImage addqueue addqueueicon+ -- adding package to files. keywordall <- imageMenuItemNewWithLabel ("keyword all " ++ catpkg) addallicon1 <- imageNewFromFile (iconpath ++ "small-add.png")@@ -214,6 +221,12 @@ imageMenuItemSetImage usepkg addicon4 -- Add items to the menu binding to their respectives operations.+ -- Add package at control panel queue. + menuShellAppend pkgmenu addqueue+ addqueue `onActivateLeaf` addatqueuefunc statbar+ separator <- separatorMenuItemNew+ menuShellAppend pkgmenu separator+ -- Use Flag package branching operation. menuShellAppend pkgmenu usepkg usepkg `onActivateLeaf` do @@ -227,13 +240,15 @@ pkgUseFlags key $ concat flagsfound -- Add and connect to the respectives operations each of the -- menu items.+ separator0 <- separatorMenuItemNew+ menuShellAppend pkgmenu separator0 menuShellAppend pkgmenu keywordall- keywordall `onActivateLeaf` + keywordall `onActivateLeaf` chooseIfDirectoryList [packagekeywords] [] (\ (file:_) -> addPackageFor file catpkg >> updateStatBar statbar (catpkg ++ " keyworded.")) menuShellAppend pkgmenu keyword- keyword `onActivateLeaf` + keyword `onActivateLeaf` chooseIfDirectoryList [packagekeywords] [] (\ (file:_) -> addPackageFor file key >> updateStatBar statbar (key ++ " keyworded."))@@ -260,6 +275,8 @@ (\ (file:_) -> addPackageFor file key >> updateStatBar statbar (key ++ " unmasked.")) + separator1 <- separatorMenuItemNew+ menuShellAppend pkgmenu separator1 menuShellAppend pkgmenu rmkeywordall rmkeywordall `onActivateLeaf` chooseIfDirectoryList [packagekeywords] []
src/UseFlag.hs view
@@ -21,8 +21,7 @@ import Graphics.UI.Gtk import Util-import Data.List (sort, nub, lookup)-import Data.Maybe (fromJust)+import Data.List (sort, nub, groupBy) import Data.Char (isSpace) type Variable = String@@ -80,10 +79,10 @@ \ flag editor for this package?." usef token useflags = do- (window, label, usevbox, textvuf, savebutton, quitbutton)+ (window, notebook, label, textvuf, savebutton, quitbutton) <- useFlagsWindow -- Take each of the useflags into the proper radio buttons panel.- radiolist <- takeFlagsToRadio usevbox useflags+ radiolist <- takeFlagsToRadio notebook useflags -- Read the make.conf or package.use flag, depending -- if we are using the global use flag editor or the -- package specific use flag editor.@@ -209,45 +208,28 @@ f (z:zs) str | last z == '\\' = f zs (str ++ init z) | otherwise = (str ++ z, zs) -takeFlagsToRadio :: [(String, VBox)] -> [String] -> IO [RadioFlag]-takeFlagsToRadio usevbox flags =+takeFlagsToRadio :: Notebook -> [String] -> IO [RadioFlag]+takeFlagsToRadio notebook flags = do let useflags = ltouseflag flags- mapM (\ x@(UseFlag flag _ ) ->- case flag of- name | f 'a' name -> radio (lookupkey "a" usevbox) x- | f 'b' name -> radio (lookupkey "b" usevbox) x- | f 'c' name -> radio (lookupkey "c" usevbox) x- | f 'd' name -> radio (lookupkey "d" usevbox) x- | f 'e' name -> radio (lookupkey "e" usevbox) x- | f 'f' name -> radio (lookupkey "f" usevbox) x- | f 'g' name -> radio (lookupkey "g" usevbox) x- | f 'h' name -> radio (lookupkey "h" usevbox) x- | f 'i' name -> radio (lookupkey "i" usevbox) x- | f 'j' name -> radio (lookupkey "j" usevbox) x- | f 'k' name -> radio (lookupkey "k" usevbox) x- | f 'l' name -> radio (lookupkey "l" usevbox) x- | f 'm' name -> radio (lookupkey "m" usevbox) x- | f 'n' name -> radio (lookupkey "n" usevbox) x- | f 'o' name -> radio (lookupkey "o" usevbox) x- | f 'p' name -> radio (lookupkey "p" usevbox) x- | f 'q' name -> radio (lookupkey "q" usevbox) x- | f 'r' name -> radio (lookupkey "r" usevbox) x- | f 's' name -> radio (lookupkey "s" usevbox) x- | f 't' name -> radio (lookupkey "t" usevbox) x- | f 'u' name -> radio (lookupkey "u" usevbox) x- | f 'v' name -> radio (lookupkey "v" usevbox) x- | f 'w' name -> radio (lookupkey "w" usevbox) x- | f 'x' name -> radio (lookupkey "x" usevbox) x- | f 'y' name -> radio (lookupkey "y" usevbox) x- | f 'z' name -> radio (lookupkey "z" usevbox) x- | otherwise -> radio (lookupkey "S" usevbox) x) useflags+ radiolist <- mapM (\ groupflags ->+ do+ let (UseFlag flag _) = head groupflags+ vbox <- createFlagBox [ head flag]+ mapM (radio vbox) groupflags) (groupFlags useflags)+ return $ concat radiolist where- f = (flip (.) head) . (==)+ groupFlags = groupBy (\ (UseFlag a _) (UseFlag b _) -> (head a) == (head b))+ createFlagBox name =+ do+ vbox <- vBoxNew False 0+ scroll <- scrolledWindowNew Nothing Nothing+ scrolledWindowAddWithViewport scroll vbox+ notebookAppendPage notebook scroll name+ return vbox ltouseflag = nub . map toUseFlag . filter (not . null) . sort- lookupkey k = fromJust . lookup k -useFlagsWindow :: IO (Window, Label, [(String, VBox)], TextView, Button, Button)+useFlagsWindow :: IO (Window, Notebook, Label, TextView, Button, Button) {- | Create USE Flag Window. -} useFlagsWindow = do@@ -276,139 +258,6 @@ -- the USE flags. notebook <- notebookNew notebookSetPopup notebook True- -- - -- These are the different vboxes containing each of- -- the use flags inside notebook panels sorted by the- -- first letter alphabetically.- --- vboxA <- vBoxNew False 0- scrollA <- scrolledWindowNew Nothing Nothing- scrolledWindowAddWithViewport scrollA vboxA-- vboxB <- vBoxNew False 0- scrollB <- scrolledWindowNew Nothing Nothing- scrolledWindowAddWithViewport scrollB vboxB-- vboxC <- vBoxNew False 0- scrollC <- scrolledWindowNew Nothing Nothing- scrolledWindowAddWithViewport scrollC vboxC-- vboxD <- vBoxNew False 0- scrollD <- scrolledWindowNew Nothing Nothing- scrolledWindowAddWithViewport scrollD vboxD-- vboxE <- vBoxNew False 0- scrollE <- scrolledWindowNew Nothing Nothing- scrolledWindowAddWithViewport scrollE vboxE-- vboxF <- vBoxNew False 0- scrollF <- scrolledWindowNew Nothing Nothing- scrolledWindowAddWithViewport scrollF vboxF-- vboxG <- vBoxNew False 0- scrollG <- scrolledWindowNew Nothing Nothing- scrolledWindowAddWithViewport scrollG vboxG-- vboxH <- vBoxNew False 0- scrollH <- scrolledWindowNew Nothing Nothing- scrolledWindowAddWithViewport scrollH vboxH-- vboxI <- vBoxNew False 0- scrollI <- scrolledWindowNew Nothing Nothing- scrolledWindowAddWithViewport scrollI vboxI-- vboxJ <- vBoxNew False 0- scrollJ <- scrolledWindowNew Nothing Nothing- scrolledWindowAddWithViewport scrollJ vboxJ-- vboxK <- vBoxNew False 0- scrollK <- scrolledWindowNew Nothing Nothing- scrolledWindowAddWithViewport scrollK vboxK-- vboxL <- vBoxNew False 0- scrollL <- scrolledWindowNew Nothing Nothing- scrolledWindowAddWithViewport scrollL vboxL-- vboxM <- vBoxNew False 0- scrollM <- scrolledWindowNew Nothing Nothing- scrolledWindowAddWithViewport scrollM vboxM-- vboxN <- vBoxNew False 0- scrollN <- scrolledWindowNew Nothing Nothing- scrolledWindowAddWithViewport scrollN vboxN-- vboxO <- vBoxNew False 0- scrollO <- scrolledWindowNew Nothing Nothing- scrolledWindowAddWithViewport scrollO vboxO-- vboxP <- vBoxNew False 0- scrollP <- scrolledWindowNew Nothing Nothing- scrolledWindowAddWithViewport scrollP vboxP-- vboxQ <- vBoxNew False 0- scrollQ <- scrolledWindowNew Nothing Nothing- scrolledWindowAddWithViewport scrollQ vboxQ-- vboxR <- vBoxNew False 0- scrollR <- scrolledWindowNew Nothing Nothing- scrolledWindowAddWithViewport scrollR vboxR-- vboxS <- vBoxNew False 0- scrollS <- scrolledWindowNew Nothing Nothing- scrolledWindowAddWithViewport scrollS vboxS-- vboxT <- vBoxNew False 0- scrollT <- scrolledWindowNew Nothing Nothing- scrolledWindowAddWithViewport scrollT vboxT-- vboxU <- vBoxNew False 0- scrollU <- scrolledWindowNew Nothing Nothing- scrolledWindowAddWithViewport scrollU vboxU-- vboxV <- vBoxNew False 0- scrollV <- scrolledWindowNew Nothing Nothing- scrolledWindowAddWithViewport scrollV vboxV-- vboxW <- vBoxNew False 0- scrollW <- scrolledWindowNew Nothing Nothing- scrolledWindowAddWithViewport scrollW vboxW-- vboxX <- vBoxNew False 0- scrollX <- scrolledWindowNew Nothing Nothing- scrolledWindowAddWithViewport scrollX vboxX-- vboxY <- vBoxNew False 0- scrollY <- scrolledWindowNew Nothing Nothing- scrolledWindowAddWithViewport scrollY vboxY-- vboxZ <- vBoxNew False 0- scrollZ <- scrolledWindowNew Nothing Nothing- scrolledWindowAddWithViewport scrollZ vboxZ-- vboxSpecial <- vBoxNew False 0- scrollSpecial <- scrolledWindowNew Nothing Nothing- scrolledWindowAddWithViewport scrollSpecial vboxSpecial- -- Use Flags panels assoc list.- let usevbox = [("a", vboxA), ("b", vboxB), ("c", vboxC)- , ("d", vboxD), ("e", vboxE), ("f", vboxF)- , ("g", vboxG), ("h", vboxH), ("i", vboxI)- , ("j", vboxJ), ("k", vboxK), ("l", vboxL)- , ("m", vboxM), ("n", vboxN), ("o", vboxO)- , ("p", vboxP), ("q", vboxQ), ("r", vboxR)- , ("s", vboxS), ("t", vboxT), ("u", vboxU)- , ("v", vboxV), ("w", vboxW), ("x", vboxX)- , ("y", vboxY), ("z", vboxZ), ("S", vboxSpecial)]- -- Add each use flag box to the respective panel.- mapM_ (\ (a, b) -> notebookAppendPage notebook a b)- [ (scrollA, "A"), (scrollB, "B"), (scrollC, "C")- , (scrollD, "D"), (scrollE, "E"), (scrollF, "F")- , (scrollG, "G"), (scrollH, "H"), (scrollI, "I")- , (scrollJ, "J"), (scrollK, "K"), (scrollL, "L")- , (scrollM, "M"), (scrollN, "N"), (scrollO, "O")- , (scrollP, "P"), (scrollQ, "Q"), (scrollR, "R")- , (scrollS, "S"), (scrollT, "T"), (scrollU, "U")- , (scrollV, "V"), (scrollW, "W"), (scrollX, "X")- , (scrollY, "Y"), (scrollZ, "Z"), (scrollSpecial, "Special") ] panedAdd2 mainpaned notebook boxPackStart mainvbox mainpaned PackGrow 5 -- Make main frame.@@ -435,7 +284,7 @@ , windowDefaultWidth := 700 , windowDefaultHeight := 400 , containerBorderWidth := 5 ]- return (window, label, usevbox, statview, savebutton, quitbutton)+ return (window, notebook, label, statview, savebutton, quitbutton) getEnvValue :: String -> [EnvValues] -> String getEnvValue _ [] = []
src/Util.hs view
@@ -34,7 +34,6 @@ (objectSetPropertyBool) import Data.List (sort) - data ProcessType = Emerge | EmergeSync | Eix deriving (Show, Eq) @@ -42,7 +41,7 @@ hname, hversion :: String hname = "Himerge"-hversion = "0.18"+hversion = "0.20" hdoc :: FilePath hdoc = "/usr/share/doc/himerge-" ++ hversion ++ "/himerge_doc.html"@@ -473,8 +472,33 @@ treeViewSetSearchColumn tv 3 -- add treeview into the scroll container. containerAdd scroll tv+ -- Panel pop-up menu.+ tv `onButtonRelease` queuePopupMenu tv return (tv, scroll) +queuePopupMenu :: TreeView -> Event -> IO Bool+queuePopupMenu tv event@(Button { eventClick = ReleaseClick , eventButton = RightButton }) =+ do+ queuemenu <- menuNew+ -- remove package from queue.+ removequeue <- imageMenuItemNewWithLabel "remove selected packages"+ removeicon <- imageNewFromFile (iconpath ++ "small-remove.png")+ imageMenuItemSetImage removequeue removeicon+ + menuShellAppend queuemenu removequeue+ removequeue `onActivateLeaf` removeElement tv+ -- clear queue.+ clearqueue <- imageMenuItemNewWithLabel "clear this package queue"+ clearicon <- imageNewFromFile (iconpath ++ "small-clear.png")+ imageMenuItemSetImage clearqueue clearicon++ menuShellAppend queuemenu clearqueue + clearqueue `onActivateLeaf` clearQueue tv+ widgetShowAll queuemenu+ menuPopup queuemenu (Just (eventButton event, eventTime event))+ return True+queuePopupMenu _ _ = return False+ storeQueueObjects :: ListStore -> Pixbuf -> [(String, String)] -> IO () storeQueueObjects st pixbuf = mapM_ (\ (s, p) -> do@@ -624,6 +648,7 @@ (GVstring (Just pkgname)) <- treeModelGetValue store node textColumn return $ ((++ "/") $ takeWhile (/= '/') pathlabel) ++ pkgname +{- | Operations around packages queue. -} removeElement :: TreeView -> IO () removeElement pkgtv = do@@ -642,8 +667,25 @@ f node' (num - 1) _ -> popErrorWindow "Util.hs, error: how it happened?" -removePageElement :: Notebook -> IO ()-removePageElement = flip isCurrentPagePackagePanel removeElement+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 :: TreeView -> IO ()+{- | Removed all the packages in the queue if any. -}+clearQueue = (listStoreClear =<<) . getStoreFromView closeTab :: WidgetClass child => Notebook -> child -> IO () closeTab nb cd =