{- Code implementing menus windows and operations related to them. 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 Menus where import Util import UseFlag import Graphics.UI.Gtk import System.Directory import qualified Control.Exception as E import System.IO import Control.Monad (liftM2) import Data.List (nub, sort) {- | File Chooser code. -} getChooser :: (IO FileChooserDialog) -> (FileChooserDialog -> IO (Maybe String)) -> (FilePath -> IO ()) -> IO () {- | Run specific dialog choosers. (Save pages and Open new repo) -} getChooser dialog fctype okfunc = do dialog >>= \ fc -> fc `onResponse` (fun fc) >> widgetShowAll fc where fun fc ResponseOk = do file <- fctype fc case file of Nothing -> popErrorWindow "No valid file." Just filename -> widgetDestroy fc >> okfunc filename fun fc _ = widgetDestroy fc {- | Save pages functions. These functions work together with the filechooser functions. -} allPages :: Notebook -> FilePath -> IO () allPages = (\ p s -> mapPanelPages p >>= allPageContents p >>= writeFile s . unlines) pageContents :: Notebook -> FilePath -> IO () pageContents panel filename = do num <- notebookGetCurrentPage panel Just widgetpage <- notebookGetNthPage panel num stringFromPage panel widgetpage >>= writeFile filename storeModelValuesToString :: TreeModel -> IO String storeModelValuesToString store = f 0 store >>= return . unlines where f index store' = do maybeiter <- treeModelGetIter store' [index] case maybeiter of Nothing -> return [] Just iter -> do (GVstring (Just value)) <- treeModelGetValue store' iter 3 rvalue <- f (index + 1) store' return (value : rvalue) allPageContents :: Notebook -> [Widget] -> IO [String] allPageContents = f where f _ [] = return [] f notebook (page:pagexs) = do xs <- stringFromPage notebook page rxs <- f notebook pagexs return (xs:rxs) stringFromPage :: Notebook -> Widget -> IO String stringFromPage notebook page = do scrollw <- return $ castToScrolledWindow page text <- notebookGetMenuLabelText notebook scrollw (Just c) <- binGetChild scrollw case text of Nothing -> error "stringFromPage: how this happened?!" (Just text') -> do if parse text' then do (Just store) <- treeViewGetModel (castToTreeView c) storeModelValuesToString store else do textb <- textViewGetBuffer (castToTextView c) startiter <- textBufferGetStartIter textb enditer <- textBufferGetEndIter textb textBufferGetText textb startiter enditer True where parse = liftM2 (||) ("Queue:" ==) ("Main" ==) . (!! 0) . words mapPanelPages :: Notebook -> IO [Widget] mapPanelPages = f 0 where f num panel = do maybewidget <- notebookGetNthPage panel num case maybewidget of Nothing -> return [] Just sp -> do rpage <- f (num + 1) panel return (sp : rpage) chooseIfDirectoryList :: [FilePath] -> [FilePath] -> ([FilePath] -> IO ()) -> IO () {- Open fileChoosers for /etc/portage directories. Use the respective files otherwise. -} chooseIfDirectoryList [] tmpfiles applyfunc = applyfunc tmpfiles chooseIfDirectoryList (pfile:pxs) tmpfiles applyfunc = do b <- doesDirectoryExist pfile case b of True -> do fc <- fileChooserDialogNew (Just pfile) Nothing FileChooserActionOpen [("Ok", ResponseOk), ("Cancel", ResponseCancel)] fileChooserSetCurrentFolder fc pfile fc `onResponse` (fun fc) widgetShowAll fc where fun fc ResponseOk = do file <- fileChooserGetFilename fc case file of Nothing -> widgetDestroy fc >> popErrorWindow "No valid file." Just filename -> widgetDestroy fc >> chooseIfDirectoryList pxs (filename : tmpfiles) applyfunc fun fc _ = widgetDestroy fc False -> chooseIfDirectoryList pxs (pfile : tmpfiles) applyfunc {- | Code for windows showing different menus. pop-up menu for packages versions and the package branch editor.-} packagePopupMenu :: FilePath -> TreeView -> Statusbar -> 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 packageMenuItems :: (String, String, String, String) -> Statusbar -> IO Menu packageMenuItems (ebuildpath, catpkg, pkg, key) statbar = do pkgmenu <- menuNew -- adding package to files. keywordall <- imageMenuItemNewWithLabel ("keyword all " ++ catpkg) addallicon1 <- imageNewFromFile (iconpath ++ "small-add.png") imageMenuItemSetImage keywordall addallicon1 keyword <- imageMenuItemNewWithLabel ("keyword " ++ pkg) addicon1 <- imageNewFromFile (iconpath ++ "small-add.png") imageMenuItemSetImage keyword addicon1 maskall <- imageMenuItemNewWithLabel ("mask all " ++ catpkg) addallicon2 <- imageNewFromFile (iconpath ++ "small-add.png") imageMenuItemSetImage maskall addallicon2 mask <- imageMenuItemNewWithLabel ("mask " ++ pkg) addicon2 <- imageNewFromFile (iconpath ++ "small-add.png") imageMenuItemSetImage mask addicon2 unmaskall <- imageMenuItemNewWithLabel ("unmask all " ++ catpkg) addallicon3 <- imageNewFromFile (iconpath ++ "small-add.png") imageMenuItemSetImage unmaskall addallicon3 unmask <- imageMenuItemNewWithLabel ("unmask " ++ pkg) addicon3 <- imageNewFromFile (iconpath ++ "small-add.png") imageMenuItemSetImage unmask addicon3 -- removing package from files. rmkeywordall <- imageMenuItemNewWithLabel ("remove keyword all " ++ catpkg) removeallicon1 <- imageNewFromFile (iconpath ++ "small-remove.png") imageMenuItemSetImage rmkeywordall removeallicon1 rmkeyword <- imageMenuItemNewWithLabel ("remove keyword " ++ pkg) removeicon1 <- imageNewFromFile (iconpath ++ "small-remove.png") imageMenuItemSetImage rmkeyword removeicon1 rmmaskall <- imageMenuItemNewWithLabel ("remove mask all " ++ catpkg) removeallicon2 <- imageNewFromFile (iconpath ++ "small-remove.png") imageMenuItemSetImage rmmaskall removeallicon2 rmmask <- imageMenuItemNewWithLabel ("remove mask " ++ pkg) removeicon2 <- imageNewFromFile (iconpath ++ "small-remove.png") imageMenuItemSetImage rmmask removeicon2 rmunmaskall <- imageMenuItemNewWithLabel ("remove unmask all " ++ pkg) removeallicon3 <- imageNewFromFile (iconpath ++ "small-remove.png") imageMenuItemSetImage rmunmaskall removeallicon3 rmunmask <- imageMenuItemNewWithLabel ("remove keyword " ++ pkg) removeicon3 <- imageNewFromFile (iconpath ++ "small-remove.png") imageMenuItemSetImage rmunmask removeicon3 -- Add package use. usepkg <- imageMenuItemNewWithLabel ("use package " ++ pkg) addicon4 <- imageNewFromFile (iconpath ++ "small-add.png") imageMenuItemSetImage usepkg addicon4 -- Add items to the menu binding to their respectives operations. menuShellAppend pkgmenu usepkg usepkg `onActivateLeaf` do allflags <- allUseFlags ebuildc <- readFile ebuildpath -- Strip '=' from =cat/pkgname (tail key). -- Find the matched flags between the USE flags and IUSE of a package. flagsfound <- return $ map (findIUSEonUSEFlags key allflags) (words $ findAtom ebuildc "IUSE") -- Open the use flag editor for this package version. pkgUseFlags key $ concat flagsfound -- Add and connect to the respectives operations each of the -- menu items. menuShellAppend pkgmenu keywordall keywordall `onActivateLeaf` chooseIfDirectoryList [packagekeywords] [] (\ (file:_) -> addPackageFor file catpkg >> updateStatBar statbar (catpkg ++ " keyworded.")) menuShellAppend pkgmenu keyword keyword `onActivateLeaf` chooseIfDirectoryList [packagekeywords] [] (\ (file:_) -> addPackageFor file key >> updateStatBar statbar (key ++ " keyworded.")) menuShellAppend pkgmenu maskall maskall `onActivateLeaf` chooseIfDirectoryList [packagemask] [] (\ (file:_) -> addPackageFor file catpkg >> updateStatBar statbar (catpkg ++ " masked.")) menuShellAppend pkgmenu mask mask `onActivateLeaf` chooseIfDirectoryList [packagemask] [] (\ (file:_) -> addPackageFor file key >> updateStatBar statbar (key ++ " masked.")) menuShellAppend pkgmenu unmaskall unmaskall `onActivateLeaf` chooseIfDirectoryList [packageunmask] [] (\ (file:_) -> addPackageFor file catpkg >> updateStatBar statbar (catpkg ++ " unmasked.")) menuShellAppend pkgmenu unmask unmask `onActivateLeaf` chooseIfDirectoryList [packageunmask] [] (\ (file:_) -> addPackageFor file key >> updateStatBar statbar (key ++ " unmasked.")) menuShellAppend pkgmenu rmkeywordall rmkeywordall `onActivateLeaf` chooseIfDirectoryList [packagekeywords] [] (\ (file:_) -> removePackageFrom file catpkg >> updateStatBar statbar (catpkg ++ " removed keyworded.")) menuShellAppend pkgmenu rmkeyword rmkeyword `onActivateLeaf` chooseIfDirectoryList [packagekeywords] [] (\ (file:_) -> removePackageFrom file key >> updateStatBar statbar (key ++ " removed keyworded.")) menuShellAppend pkgmenu rmmaskall rmmaskall `onActivateLeaf` chooseIfDirectoryList [packagemask] [] (\ (file:_) -> removePackageFrom file catpkg >> updateStatBar statbar (catpkg ++ " removed mask.")) menuShellAppend pkgmenu rmmask rmmask `onActivateLeaf` chooseIfDirectoryList [packagemask] [] (\ (file:_) -> removePackageFrom file key >> updateStatBar statbar (key ++ " removed mask.")) menuShellAppend pkgmenu rmunmaskall rmunmaskall `onActivateLeaf` chooseIfDirectoryList [packageunmask] [] (\ (file:_) -> removePackageFrom file catpkg >> updateStatBar statbar (catpkg ++ " removed unmask.")) menuShellAppend pkgmenu rmunmask rmunmask `onActivateLeaf` chooseIfDirectoryList [packageunmask] [] (\ (file:_) -> removePackageFrom file key >> updateStatBar statbar (key ++ " removed unmask.")) -- Show menu. widgetShowAll pkgmenu return pkgmenu findIUSEonUSEFlags :: String -> [String] -> String -> [String] {- This function finds the IUSE flags located either in the local use flags and the global use flags list (all flags). It tests for local use flags of the form: category/package:use - desc. ; and matches against (category/package == catpkgname) and (use == iuse) to find the correct local use flags of a package in the list of all flags. -} findIUSEonUSEFlags catpkgname flags iuseflag = filter (not . null) $ map f flags where f flag = let (h, t) = break (== ':') $ takeWhile (/= ' ') flag in case t of [] -> if h == iuseflag then flag else [] (_:t') -> if (findSubstring h catpkgname) then (if t' == iuseflag then (tail $ dropWhile (/= ':') flag) else []) else [] addPackageFor, removePackageFrom :: FilePath -> String -> IO () addPackageFor = packageFile (\ k -> (k :)) removePackageFrom = packageFile (\ k -> filter (/= k)) packageFile :: (String -> ([String] -> [String])) -> FilePath -> String -> IO () packageFile func = f where f path key = do let writehandle wfileh = hPutStr wfileh . unlines . sort . nub . func key createDirectoryIfMissing True etcpackage fb <- doesFileExist path list <- case fb of True -> (do rfileh <- openFile path ReadMode str <- (hGetContents rfileh >>= E.evaluate) hClose rfileh return $ map strip $ lines str) `E.catch` (\ e -> (popErrorWindow $ show e) >> return []) False -> return [] (do w <- openFile path WriteMode writehandle w list hClose w) `E.catch` (\ e -> popErrorWindow $ show e) {- | Start code for the package branch editor window. -} packageBranch :: IO () packageBranch = chooseIfDirectoryList [ packageuse, packageunmask , packagemask, packagekeywords ] [] showBranch branchStore :: [FilePath] -> IO [(TreeView, ScrolledWindow, CellRendererText)] branchStore = mapM (\ file -> do contents <- readFileIfExist file createStore file SelectionMultiple True (Just (packageicon, skipBCLines $ lines contents))) where skipBCLines = filter f f [] = False f ('#':_) = False f _ = True showBranch :: [FilePath] -> IO () {- | Package Branch Window. -} showBranch [keywordsfile, maskfile, unmaskfile, usefile] = do window <- windowNew panel <- notebookNew notebookSetScrollable panel True notebookSetPopup panel True vbox <- vBoxNew False 9 [(keyview, keyscroll, keycell), (maskview, maskscroll, maskcell) , (unmaskview, unmaskscroll, unmaskcell), (useview, usescroll, usecell)] <- branchStore [keywordsfile, maskfile , unmaskfile, usefile] -- Add a logo. image <- imageNewFromFile windowlogo boxPackStart vbox image PackNatural 0 -- Add a horizontal separator. notebookAppendPage panel keyscroll "Package Keywords" notebookAppendPage panel maskscroll "Package Mask" notebookAppendPage panel unmaskscroll "Package Unmask" notebookAppendPage panel usescroll "Package Use" -- Add the package branch panel into a frame. branchframe <- makeFrame "Package Brach" 0.50 0.50 containerSetBorderWidth panel 9 containerAdd branchframe panel -- Add the branch frame into the vbox. boxPackStart vbox branchframe PackGrow 0 -- Add a horizontal separator buttonbox <- hBoxNew False 0 removebutton <- buttonNewFromStock stockRemove savebutton <- buttonNewFromStock stockSave quitbutton <- buttonNewFromStock stockClose boxPackStart buttonbox removebutton PackNatural 0 boxPackStart buttonbox savebutton PackNatural 0 boxPackStart buttonbox quitbutton PackNatural 0 boxPackStart vbox buttonbox PackNatural 0 removebutton `onClicked` do c <- notebookGetCurrentPage panel case c of 0 -> removeElement keyview 1 -> removeElement maskview 2 -> removeElement unmaskview 3 -> removeElement useview _ -> popErrorWindow "Components.hs - error: weird, how this happened?" let list = [ (keyview, keywordsfile), (maskview, maskfile) , (unmaskview, unmaskfile), (useview, usefile) ] savebutton `onClicked` popSelectWindow "Do you want to save this packages setup?" (mapM_ (\ (view, file) -> do store <- getStoreFromView view str <- collectIters store 0 >>= collectStringValues store textColumn writeFileIfExist file $ unlines str) list) quitbutton `onClicked` widgetDestroy window -- The cells of this treeview are editable. keystore <- getStoreFromView keyview usestore <- getStoreFromView useview maskstore <- getStoreFromView maskview unmaskstore <- getStoreFromView unmaskview -- Update the tree store contents after edited. afterEdited keycell keystore (editOn $ castToListStore keystore) afterEdited usecell usestore (editOn $ castToListStore usestore) afterEdited maskcell maskstore (editOn $ castToListStore maskstore) afterEdited unmaskcell unmaskstore (editOn $ castToListStore unmaskstore) set window [ windowTitle := "Himerge Package Branch" , windowDefaultWidth := 600 , windowDefaultHeight := 500 , containerChild := vbox , containerBorderWidth := 5 ] widgetShowAll window where editOn store = \ iter str -> listStoreSetValue store iter textColumn (GVstring $ Just str) showBranch _ = error "showBranch: How in the world did this happen?"