himerge 0.17.9 → 0.18
raw patch · 9 files changed
+271/−47 lines, 9 files
Files
- ChangeLog +11/−1
- data/himerge/doc/himerge_doc.html +2/−2
- himerge.cabal +2/−1
- install_data.sh +2/−2
- readme.txt +2/−2
- src/Browser.hs +47/−10
- src/Emerge.hs +22/−13
- src/UseFlag.hs +181/−14
- src/Util.hs +2/−2
ChangeLog view
@@ -1,5 +1,15 @@ Himerge -- Haskell Interface for Emerge +-- version 0.18 (Apr, 01, 2008)++ 1 - USE flag browser improved. It now shows use flags classified+ alphabetically on independent panels.+ 2 - Himerge now correctly handles the reload procedure of portage during+ the installation of packages.+ 3 - The tree views interface is slightly improved. Now the views are+ updated when pressing 'Enter' on each row too.+ 4 - Some code refactored.+ -- version 0.17.9 (Mar, 04, 2008) 1 - The use flags browser has been improved to correctly parse certain use@@ -97,7 +107,7 @@ 12 - Added the Himerge logo in some part of the application and components. 13 - Some bugs fixed and slight code refactoring in several functions. --- version 0.13+-- version 0.13 (May, 03, 2007) 1 - First release.
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.17</b></p>+<p class="newshead" lang="en"><b>Himerge 0.18</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.17</strong></li>+ <li><strong>Features on Himerge 0.18</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>
himerge.cabal view
@@ -1,9 +1,10 @@ Name: himerge-Version: 0.17.9+Version: 0.18 License: GPL License-File: LICENSE Author: Luis Francisco Araujo Maintainer: araujo@gentoo.org+Homepage: http://www.haskell.org/himerge Stability: Beta Synopsis: Haskell Graphical User Interface for Emerge Description:
install_data.sh view
@@ -1,7 +1,7 @@ # -# himerge 0.17+# himerge 0.18 #-VERSION="0.17.9"+VERSION="0.18" 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.17.9 (Lotus)+Version: 0.18 (Himalaya) Status: Beta Dependencies:@@ -43,4 +43,4 @@ Luis Francisco Araujo araujo@gentoo.org -Tue Mar 4 11:21:15 VET 2008+Sun Mar 30 22:08:49 VET 2008
src/Browser.hs view
@@ -42,22 +42,34 @@ type Browser = (VBox, Notebook, TextView, Statusbar, ProgressBar, MozEmbed, Tooltips) -buttonIconList :: [(String, String)]-buttonIconList = +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") , ("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")+ ]++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)")- , ("emerge", "Install the packages listed on the queue")+ ]++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")- , ("system", "Caculate the 'system' packages and add them into the queue")+ ]++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") ] @@ -70,7 +82,8 @@ , "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?" ]+ , "Do you only want to fetch queded packages?" + ] portageBrowser :: FilePath -> IO Browser portageBrowser prepo = @@ -88,10 +101,21 @@ 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+ , clearqueuebutton ]+ <- 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@@ -257,6 +281,8 @@ -- 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 >>=@@ -264,9 +290,20 @@ (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
src/Emerge.hs view
@@ -30,7 +30,7 @@ import qualified Control.Exception as E -data EmergeParse = EmergeSuccessDep | EmergeBlockError String +data EmergeParse = EmergeSuccessDep [String] | EmergeBlockError String deriving Show blockerrormsg :: String@@ -39,6 +39,9 @@ \\n\ \http://www.gentoo.org/doc/en/handbook/handbook-x86.xml?full=1#blocked" +portagereloadinfo :: String+portagereloadinfo = "INFO=Portage will stop merging at this point and reload itself"+ emergepath :: FilePath emergepath = envbin ++ " emerge --color=n " @@ -53,20 +56,26 @@ do output <- hGetContents out E.evaluate output - let pkgs = lines output- case checkDepOutput pkgs of- EmergeSuccessDep -> return $ map f $ takeWhile (not . null) $ lines $ dropWhile (/= '[') output- EmergeBlockError xs -> popErrorWindow xs >> return []+ let pkgs = lines $ dropWhile (/= '[') output+ case checkDepOutput pkgs [] of+ EmergeSuccessDep parsedpkgs -> return $ map f $ takeWhile (not . null) $ parsedpkgs+ EmergeBlockError xs -> popErrorWindow xs >> return [] where- f pkg = let (s:rs) = words $ dropWhile (/= ' ') pkg- in- let p = dropWhile (not . isAlpha) $ unwords rs in (filter isAlpha s, p)+ f pkg = let (s:rs) = words $ dropWhile (/= ' ') pkg + in+ let p = dropWhile (not . isAlpha) $ unwords rs in (filter isAlpha s, p) -checkDepOutput :: [String] -> EmergeParse-checkDepOutput [] = EmergeSuccessDep-checkDepOutput (('[':'b':'l':'o':'c':'k':'s':xs):_) = - EmergeBlockError ((drop 2 $ dropWhile (/= ']') xs) ++ blockerrormsg)-checkDepOutput (_:xs) = checkDepOutput xs+checkDepOutput :: [String] -> [String] -> EmergeParse+checkDepOutput [] pkgs = EmergeSuccessDep pkgs+checkDepOutput (('[':'b':'l':'o':'c':'k':'s':xs):_) _ =+ EmergeBlockError ((drop 2 $ dropWhile (/= ']') xs) ++ blockerrormsg)+checkDepOutput (x:xs) pkgs = + case x of+ ('*':'*':'*':' ':'P':_) ->+ if (findSubstring "stop" x)+ then checkDepOutput xs (pkgs ++ ["[ R ] sys-apps/portage " ++ portagereloadinfo])+ else checkDepOutput xs (pkgs ++ [x])+ _ -> checkDepOutput xs (pkgs ++ [x]) equeryOutput :: Handle -> IO [(String, String)] equeryOutput out =
src/UseFlag.hs view
@@ -21,7 +21,8 @@ import Graphics.UI.Gtk import Util-import Data.List (sort, nub)+import Data.List (sort, nub, lookup)+import Data.Maybe (fromJust) import Data.Char (isSpace) type Variable = String@@ -31,7 +32,7 @@ data UseFlag = UseFlag String String data RadioFlag = Radio String [RadioButton] data EnvValues = EnvValue Variable Value | Comment String- deriving Show+ deriving Show instance Eq UseFlag where UseFlag use _ == UseFlag use' _ = use == use'@@ -79,10 +80,10 @@ \ flag editor for this package?." usef token useflags = do- (window, label, vbox, textvuf, savebutton, quitbutton)+ (window, label, usevbox, textvuf, savebutton, quitbutton) <- useFlagsWindow- -- take a list of useflags into one of radio buttons.- radiolist <- takeFlagsToRadio vbox useflags+ -- Take each of the useflags into the proper radio buttons panel.+ radiolist <- takeFlagsToRadio usevbox 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.@@ -208,11 +209,45 @@ f (z:zs) str | last z == '\\' = f zs (str ++ init z) | otherwise = (str ++ z, zs) -takeFlagsToRadio :: VBox -> [String] -> IO [RadioFlag]-takeFlagsToRadio = (. (nub . map toUseFlag . filter (not . null) . sort)) - . mapM . radio+takeFlagsToRadio :: [(String, VBox)] -> [String] -> IO [RadioFlag]+takeFlagsToRadio usevbox 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+ where+ f = (flip (.) head) . (==)+ ltouseflag = nub . map toUseFlag . filter (not . null) . sort+ lookupkey k = fromJust . lookup k -useFlagsWindow :: IO (Window, Label, VBox, TextView, Button, Button)+useFlagsWindow :: IO (Window, Label, [(String, VBox)], TextView, Button, Button) {- | Create USE Flag Window. -} useFlagsWindow = do@@ -239,10 +274,142 @@ panedAdd1 mainpaned cflagbox -- The main radiobutton widget listing all -- the USE flags.- vbox <- vBoxNew False 0- scroll <- scrolledWindowNew Nothing Nothing- scrolledWindowAddWithViewport scroll vbox- panedAdd2 mainpaned scroll+ 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. mainframe <- makeFrame "USE Flags" 0.50 0.50@@ -268,7 +435,7 @@ , windowDefaultWidth := 700 , windowDefaultHeight := 400 , containerBorderWidth := 5 ]- return (window, label, vbox, statview, savebutton, quitbutton)+ return (window, label, usevbox, statview, savebutton, quitbutton) getEnvValue :: String -> [EnvValues] -> String getEnvValue _ [] = []
src/Util.hs view
@@ -36,13 +36,13 @@ data ProcessType = Emerge | EmergeSync | Eix- deriving (Show, Eq)+ deriving (Show, Eq) data TabButtons = StopButton | CloseButton | StopCloseButton hname, hversion :: String hname = "Himerge"-hversion = "0.17.9"+hversion = "0.18" hdoc :: FilePath hdoc = "/usr/share/doc/himerge-" ++ hversion ++ "/himerge_doc.html"