[bustle] 01/01: Imported Upstream version 0.5.2
Hector Oron
zumbi at moszumanska.debian.org
Sun Jan 10 11:09:46 UTC 2016
This is an automated email from the git hooks/post-receive script.
zumbi pushed a commit to branch upstream
in repository bustle.
commit 9c1ea1aa8936d468c84440af6705291a8d8381fc
Author: Héctor Orón Martínez <zumbi at debian.org>
Date: Sun Jan 10 12:09:05 2016 +0100
Imported Upstream version 0.5.2
---
Bustle/Application/Monad.hs | 3 +-
Bustle/Loader.hs | 6 +-
Bustle/Loader/OldSkool.hs | 12 +-
Bustle/Noninteractive.hs | 4 +-
Bustle/Renderer.hs | 2 +-
Bustle/UI.hs | 148 ++++++++------
Bustle/UI/AboutDialog.hs | 12 +-
Bustle/UI/Canvas.hs | 35 ++--
Bustle/UI/FilterDialog.hs | 28 ++-
Bustle/UI/OpenTwoDialog.hs | 17 +-
Bustle/UI/Recorder.hs | 48 +++--
Bustle/UI/Util.hs | 2 +-
Bustle/VariantFormatter.hs | 2 +
GetText.hs | 220 +++++++++++++++++++++
LICENSE.bundled-libraries | 4 +-
Makefile | 21 +-
NEWS.md | 26 ++-
README.md | 2 +-
Setup.hs | 31 +--
Test/Regions.hs | 3 +
Test/Renderer.hs | 1 +
bustle.cabal | 39 +++-
data/OpenTwoDialog.ui | 133 +++++++++++++
data/bustle.ui | 461 ++++++++++++++++----------------------------
24 files changed, 786 insertions(+), 474 deletions(-)
diff --git a/Bustle/Application/Monad.hs b/Bustle/Application/Monad.hs
index 6d7f3c9..ce593df 100644
--- a/Bustle/Application/Monad.hs
+++ b/Bustle/Application/Monad.hs
@@ -31,6 +31,7 @@ module Bustle.Application.Monad
)
where
+import Control.Applicative
import Control.Monad.Reader
import Control.Monad.State
@@ -55,7 +56,7 @@ import Data.IORef
- embedIO $ onDance x . makeCallback dancedCB
-}
newtype Bustle config state a = B (ReaderT (BustleEnv config state) IO a)
- deriving (Functor, Monad, MonadIO)
+ deriving (Functor, Applicative, Monad, MonadIO)
newtype BustleEnv config state =
BustleEnv { unBustleEnv :: (config, IORef state) }
diff --git a/Bustle/Loader.hs b/Bustle/Loader.hs
index 121d8df..ea86256 100644
--- a/Bustle/Loader.hs
+++ b/Bustle/Loader.hs
@@ -26,7 +26,7 @@ module Bustle.Loader
where
import Control.Exception
-import Control.Monad.Error
+import Control.Monad.Except
import Control.Arrow ((***))
import Text.Printf
@@ -39,15 +39,13 @@ import Bustle.Translation (__)
import Bustle.Util (io)
data LoadError = LoadError FilePath String
-instance Error LoadError where
- strMsg = LoadError ""
-- this nested case stuff is ugly, but it's less ugly than it looked with
-- combinators to turn IO (Either a b) into ErrorT LoadError IO b using various
-- a -> LoadError functions.
readLog :: MonadIO io
=> FilePath
- -> ErrorT LoadError io ([String], Log)
+ -> ExceptT LoadError io ([String], Log)
readLog f = do
pcapResult <- io $ Pcap.readPcap f
liftM (id *** filter (isRelevant . deEvent)) $ case pcapResult of
diff --git a/Bustle/Loader/OldSkool.hs b/Bustle/Loader/OldSkool.hs
index 88d5548..38167b2 100644
--- a/Bustle/Loader/OldSkool.hs
+++ b/Bustle/Loader/OldSkool.hs
@@ -29,16 +29,8 @@ import Text.ParserCombinators.Parsec hiding (Parser)
import Data.Map (Map)
import Data.Maybe (isJust)
import qualified Data.Map as Map
-import Control.Monad (ap, when, guard)
-import Control.Applicative ((<$>))
-
-infixl 4 <*
-(<*) :: Monad m => m a -> m b -> m a
-m <* n = do ret <- m; n; return ret
-
-infixl 4 <*>
-(<*>) :: Monad m => m (a -> b) -> m a -> m b
-(<*>) = ap
+import Control.Monad (when, guard)
+import Control.Applicative ((<$>), (<*>), (<*))
type Parser a = GenParser Char (Map (TaggedBusName, Serial) (Detailed Message)) a
diff --git a/Bustle/Noninteractive.hs b/Bustle/Noninteractive.hs
index cc64a9f..b96b87f 100644
--- a/Bustle/Noninteractive.hs
+++ b/Bustle/Noninteractive.hs
@@ -29,7 +29,7 @@ import System.Exit (exitFailure)
import System.IO (hPutStrLn, stderr)
import Data.Maybe (mapMaybe)
import Data.List (nub)
-import Control.Monad.Error
+import Control.Monad.Except
import Text.Printf
import Bustle.Loader
@@ -42,7 +42,7 @@ warn = hPutStrLn stderr
process :: FilePath -> (Log -> [a]) -> (a -> String) -> IO ()
process filepath analyze format = do
- ret <- runErrorT $ readLog filepath
+ ret <- runExceptT $ readLog filepath
case ret of
Left (LoadError _ err) -> do
warn $ printf (__ "Couldn't parse '%s': %s") filepath err
diff --git a/Bustle/Renderer.hs b/Bustle/Renderer.hs
index 1ddb778..b8177cd 100644
--- a/Bustle/Renderer.hs
+++ b/Bustle/Renderer.hs
@@ -50,7 +50,7 @@ import Data.Map (Map)
import Control.Applicative (Applicative(..), (<$>), (<*>))
import Control.Arrow ((***))
-import Control.Monad.Error
+import Control.Monad.Except
import Control.Monad.Identity
import Control.Monad.State
import Control.Monad.Writer
diff --git a/Bustle/UI.hs b/Bustle/UI.hs
index 733dd08..5f34dd8 100644
--- a/Bustle/UI.hs
+++ b/Bustle/UI.hs
@@ -24,7 +24,7 @@ where
import Control.Monad.Reader
import Control.Monad.State
-import Control.Monad.Error
+import Control.Monad.Except
import Data.IORef
import qualified Data.Set as Set
@@ -53,6 +53,7 @@ import Bustle.Loader
import qualified Control.Exception as C
import System.Glib.GError (GError(..), failOnGError)
+import System.Glib.Properties (objectSetPropertyMaybeString)
import Graphics.UI.Gtk
@@ -62,7 +63,7 @@ import System.FilePath ( splitFileName, takeFileName, takeDirectory
, dropExtension, dropTrailingPathSeparator
, (</>), (<.>)
)
-import System.Directory (renameFile)
+import System.GIO.File.File (fileFromParseName, fileMove, FileCopyFlags(..))
type B a = Bustle BConfig BState a
@@ -80,8 +81,9 @@ data Page =
data WindowInfo =
WindowInfo { wiWindow :: Window
- , wiSave :: ImageMenuItem
- , wiExport :: MenuItem
+ , wiHeaderBar :: Widget -- TODO
+ , wiSave :: Button
+ , wiExport :: Button
, wiViewStatistics :: CheckMenuItem
, wiFilterNames :: MenuItem
, wiNotebook :: Notebook
@@ -171,9 +173,9 @@ loadLog = loadLogWith emptyWindow
openLog :: MonadIO io
=> LogDetails
- -> ErrorT LoadError io ( ([String], [DetailedEvent])
- , ([String], [DetailedEvent])
- )
+ -> ExceptT LoadError io ( ([String], [DetailedEvent])
+ , ([String], [DetailedEvent])
+ )
openLog (RecordedLog filepath) = do
result <- readLog filepath
return (result, ([], []))
@@ -189,7 +191,7 @@ loadLogWith :: B WindowInfo -- ^ action returning a window to load the log(s)
-> LogDetails
-> B ()
loadLogWith getWindow logDetails = do
- ret <- runErrorT $ do
+ ret <- runExceptT $ do
((sessionWarnings, sessionMessages),
(systemWarnings, systemMessages)) <- openLog logDetails
@@ -235,6 +237,13 @@ aChallengerAppears wi rr = do
canvasScrollToBottom (wiCanvas wi)
setPage wi CanvasPage
+onMenuItemActivate :: MenuItemClass menuItem
+ => menuItem
+ -> IO ()
+ -> IO (ConnectId menuItem)
+onMenuItemActivate mi act =
+ on mi menuItemActivate act
+
finishedRecording :: WindowInfo
-> FilePath
-> Bool
@@ -250,7 +259,7 @@ finishedRecording wi tempFilePath producedOutput = do
io $ do
widgetSetSensitivity saveItem True
- onActivateLeaf saveItem $ showSaveDialog wi (return ())
+ saveItem `on` buttonActivated $ showSaveDialog wi (return ())
return ()
else do
setPage wi InstructionsPage
@@ -266,7 +275,22 @@ showSaveDialog wi savedCb = do
tempFileName = takeFileName tempFilePath
recorderChooseFile tempFileName mwindow $ \newFilePath -> do
- renameFile tempFilePath newFilePath
+ let tempFile = fileFromParseName tempFilePath
+ let newFile = fileFromParseName newFilePath
+
+ C.catch (fileMove tempFile newFile [FileCopyOverwrite] Nothing Nothing) $ \(GError _ _ msg) -> do
+ d <- messageDialogNew mwindow [DialogModal] MessageError ButtonsOk (__ "Couldn't save log")
+ let secondary :: String
+ secondary = printf
+ (__ "Error: <i>%s</i>\n\n\
+ \You might want to manually recover the log from the temporary file at\n\
+ \<tt>%s</tt>") (toString msg) tempFilePath
+ messageDialogSetSecondaryMarkup d secondary
+ widgetShowAll d
+ d `after` response $ \_ -> do
+ widgetDestroy d
+ return ()
+
widgetSetSensitivity (wiSave wi) False
wiSetLogDetails wi (SingleLog newFilePath)
savedCb
@@ -295,7 +319,7 @@ promptToSave wi = io $ do
dialogAddButton prompt stockSave ResponseYes
widgetShowAll prompt
- prompt `afterResponse` \resp -> do
+ prompt `after` response $ \resp -> do
let closeUp = widgetDestroy (wiWindow wi)
case resp of
ResponseYes -> showSaveDialog wi closeUp
@@ -320,15 +344,16 @@ emptyWindow = do
let getW cast name = io $ builderGetObject builder cast name
window <- getW castToWindow "diagramWindow"
- [newItem, openItem, saveItem, closeItem, aboutItem] <-
- mapM (getW castToImageMenuItem)
- ["new", "open", "save", "close", "about"]
- [newButton, openButton] <- mapM (getW castToButton) ["newButton", "openButton"]
- exportItem <- getW castToMenuItem "export"
- openTwoItem <- getW castToMenuItem "openTwo"
+ header <- getW castToWidget "header"
+
+ [openItem, openTwoItem] <- mapM (getW castToMenuItem) ["open", "openTwo"]
+ [headerNew, headerSave, headerExport] <- mapM (getW castToButton) ["headerNew", "headerSave", "headerExport"]
+
viewStatistics <- getW castToCheckMenuItem "statistics"
filterNames <- getW castToMenuItem "filter"
+ aboutItem <- getW castToMenuItem "about"
+ [newButton, openButton] <- mapM (getW castToButton) ["newButton", "openButton"]
[nb, statsBook] <- mapM (getW castToNotebook)
["diagramOrNot", "statsBook"]
@@ -336,26 +361,29 @@ emptyWindow = do
-- Open two logs dialog
openTwoDialog <- embedIO $ \r ->
- setupOpenTwoDialog builder window $ \f1 f2 ->
+ setupOpenTwoDialog window $ \f1 f2 ->
makeCallback (loadInInitialWindow (TwoLogs f1 f2)) r
-- Set up the window itself
- embedIO $ onDestroy window . makeCallback maybeQuit
+ embedIO $ (window `on` objectDestroy) . makeCallback maybeQuit
-- File menu and related buttons
embedIO $ \r -> do
let new = makeCallback startRecording r
- onActivateLeaf newItem new
- onClicked newButton new
+ forM [headerNew, newButton] $ \button ->
+ button `on` buttonActivated $ new
- let open = makeCallback (openDialogue window) r
- onActivateLeaf openItem open
- onClicked openButton open
+ let open = makeCallback openDialogue r
+ onMenuItemActivate openItem open
+ openButton `on` buttonActivated $ open
- onActivateLeaf openTwoItem $ widgetShowAll openTwoDialog
+ onMenuItemActivate openTwoItem $ widgetShowAll openTwoDialog
- -- Help menu
- io $ onActivateLeaf aboutItem $ showAboutDialog window
+ -- TODO: really this wants to live in the application menu, but that entails binding GApplication,
+ -- GtkApplication, GMenu, GActionMap, GActionEntry, ...
+ --
+ -- Similarly, the drop-down menus would look better as popovers. But here we are.
+ io $ onMenuItemActivate aboutItem $ showAboutDialog window
m <- asks methodIcon
s <- asks signalIcon
@@ -377,8 +405,9 @@ emptyWindow = do
logDetailsRef <- io $ newIORef Nothing
let windowInfo = WindowInfo { wiWindow = window
- , wiSave = saveItem
- , wiExport = exportItem
+ , wiHeaderBar = header
+ , wiSave = headerSave
+ , wiExport = headerExport
, wiViewStatistics = viewStatistics
, wiFilterNames = filterNames
, wiNotebook = nb
@@ -391,9 +420,6 @@ emptyWindow = do
}
io $ window `on` deleteEvent $ promptToSave windowInfo
- io $ closeItem `on` menuItemActivate $ do
- prompted <- promptToSave windowInfo
- when (not prompted) (widgetDestroy window)
incWindows
io $ widgetShow window
return windowInfo
@@ -422,30 +448,27 @@ updateDisplayedLog wi rr = io $ do
canvasSetShapes canvas shapes regions (rrCentreOffset rr) windowWidth
-prettyDirectory :: String
- -> String
-prettyDirectory s = "(" ++ dropTrailingPathSeparator s ++ ")"
+splitFileName_ :: String
+ -> (String, String)
+splitFileName_ s = (dropTrailingPathSeparator d, f)
+ where
+ (d, f) = splitFileName s
logWindowTitle :: LogDetails
- -> String
-logWindowTitle (RecordedLog filepath) = "(*) " ++ takeFileName filepath
-logWindowTitle (SingleLog filepath) =
- intercalate " " [name, prettyDirectory directory]
+ -> (String, Maybe String)
+logWindowTitle (RecordedLog filepath) = ("*" ++ takeFileName filepath, Nothing)
+logWindowTitle (SingleLog filepath) = (name, Just directory)
where
- (directory, name) = splitFileName filepath
+ (directory, name) = splitFileName_ filepath
logWindowTitle (TwoLogs sessionPath systemPath) =
- intercalate " " $ filter (not . null)
- [ sessionName, sessionDirectory'
- , "&"
- , systemName, prettyDirectory systemDirectory
- ]
+ -- TODO: this looks terrible, need a custom widget
+ (sessionName ++ " & " ++ systemName,
+ Just $ if sessionDirectory == systemDirectory
+ then sessionDirectory
+ else sessionDirectory ++ " & " ++ systemDirectory)
where
- (sessionDirectory, sessionName) = splitFileName sessionPath
- (systemDirectory, systemName ) = splitFileName systemPath
- sessionDirectory' =
- if sessionDirectory == systemDirectory
- then ""
- else prettyDirectory sessionDirectory
+ (sessionDirectory, sessionName) = splitFileName_ sessionPath
+ (systemDirectory, systemName ) = splitFileName_ systemPath
logTitle :: LogDetails
-> String
@@ -460,8 +483,10 @@ wiSetLogDetails :: WindowInfo
-> IO ()
wiSetLogDetails wi logDetails = do
writeIORef (wiLogDetails wi) (Just logDetails)
- windowSetTitle (wiWindow wi)
- (printf (__ "%s - Bustle") (logWindowTitle logDetails) :: String)
+ let (title, subtitle) = logWindowTitle logDetails
+ (wiWindow wi) `set` [ windowTitle := title ]
+ -- TODO: add to gtk2hs
+ objectSetPropertyMaybeString "subtitle" (wiHeaderBar wi) subtitle
setPage :: MonadIO io
=> WindowInfo
@@ -495,7 +520,7 @@ displayLog wi@(WindowInfo { wiWindow = window
updateDisplayedLog wi rr
widgetSetSensitivity exportItem True
- onActivateLeaf exportItem $ do
+ exportItem `on` buttonActivated $ do
shapes <- canvasGetShapes canvas
saveToPDFDialogue wi shapes
@@ -513,7 +538,7 @@ displayLog wi@(WindowInfo { wiWindow = window
else widgetHide statsBook
widgetSetSensitivity filterNames True
- onActivateLeaf filterNames $ do
+ onMenuItemActivate filterNames $ do
hidden <- readIORef hiddenRef
hidden' <- runFilterDialog window (sessionParticipants $ rrApplications rr) hidden
writeIORef hiddenRef hidden'
@@ -529,17 +554,16 @@ loadPixbuf filename = do
C.catch (fmap Just (pixbufNewFromFile iconName))
(\(GError _ _ msg) -> warn (toString msg) >> return Nothing)
-openDialogue :: Window -> B ()
-openDialogue window = embedIO $ \r -> do
- chooser <- fileChooserDialogNew Nothing (Just window) FileChooserActionOpen
+openDialogue :: B ()
+openDialogue = embedIO $ \r -> do
+ chooser <- fileChooserDialogNew Nothing Nothing FileChooserActionOpen
[ ("gtk-cancel", ResponseCancel)
, ("gtk-open", ResponseAccept)
]
- chooser `set` [ windowModal := True
- , fileChooserLocalOnly := True
+ chooser `set` [ fileChooserLocalOnly := True
]
- chooser `afterResponse` \resp -> do
+ chooser `after` response $ \resp -> do
when (resp == ResponseAccept) $ do
Just fn <- fileChooserGetFilename chooser
makeCallback (loadInInitialWindow (SingleLog fn)) r
@@ -574,7 +598,7 @@ saveToPDFDialogue wi shapes = do
TwoLogs p _ -> Just $ takeDirectory p
maybeM mdirectory $ fileChooserSetCurrentFolder chooser
- chooser `afterResponse` \resp -> do
+ chooser `after` response $ \resp -> do
when (resp == ResponseAccept) $ do
Just fn <- io $ fileChooserGetFilename chooser
let (width, height) = diagramDimensions shapes
diff --git a/Bustle/UI/AboutDialog.hs b/Bustle/UI/AboutDialog.hs
index 7ef4ce5..c7b3629 100644
--- a/Bustle/UI/AboutDialog.hs
+++ b/Bustle/UI/AboutDialog.hs
@@ -46,16 +46,16 @@ showAboutDialog window = do
dialog `set` [ aboutDialogName := __ "Bustle"
, aboutDialogVersion := showVersion version
, aboutDialogComments := __ "Someone's favourite D-Bus profiler"
- , aboutDialogWebsite := "http://willthompson.co.uk/bustle"
+ , aboutDialogWebsite := "http://www.freedesktop.org/wiki/Software/Bustle/"
, aboutDialogAuthors := authors
- , aboutDialogCopyright := "© 2008–2014 Will Thompson, Collabora Ltd. and contributors"
+ , aboutDialogCopyright := "© 2008–2015 Will Thompson, Collabora Ltd. and contributors"
, aboutDialogLicense := license
+ , aboutDialogLogoIconName := Just "bustle"
+ , windowModal := True
+ , windowTransientFor := window
]
- dialog `afterResponse` \resp ->
+ dialog `after` response $ \resp ->
when (resp == ResponseCancel) (widgetDestroy dialog)
- windowSetTransientFor dialog window
- windowSetModal dialog True
- aboutDialogSetLogoIconName dialog (Just "bustle")
widgetShowAll dialog
diff --git a/Bustle/UI/Canvas.hs b/Bustle/UI/Canvas.hs
index 13ec44e..2bfd87b 100644
--- a/Bustle/UI/Canvas.hs
+++ b/Bustle/UI/Canvas.hs
@@ -35,6 +35,7 @@ import Data.IORef
import Control.Monad (when)
import Graphics.UI.Gtk
+import Graphics.Rendering.Cairo (Render, translate)
import Bustle.Diagram
import Bustle.Regions
@@ -131,11 +132,7 @@ setupCanvas canvas = do
"End" -> updateWith regionSelectionLast
_ -> stopEvent
- -- Expose events
- -- I think we could speed things up by only showing the revealed area
- -- rather than everything that's visible.
- layout `on` exposeEvent $ tryEvent $ io $ canvasUpdate canvas
-
+ layout `on` draw $ canvasDraw canvas
return ()
canvasInvalidateArea :: Canvas a
@@ -257,30 +254,30 @@ canvasGetShapes :: Canvas a
canvasGetShapes = readIORef . canvasShapes
-- | Redraws the currently-visible area of the canvas
-canvasUpdate :: Canvas a
- -> IO ()
-canvasUpdate canvas = do
- current <- canvasGetSelection canvas
- shapes <- canvasGetShapes canvas
- width <- readIORef $ canvasWidth canvas
+canvasDraw :: Canvas a
+ -> Render ()
+canvasDraw canvas = do
+ current <- io $ canvasGetSelection canvas
+ shapes <- io $ canvasGetShapes canvas
+ width <- io $ readIORef $ canvasWidth canvas
let shapes' = case current of
Nothing -> shapes
Just (Stripe y1 y2, _) -> Highlight (0, y1, width, y2):shapes
let layout = canvasLayout canvas
- hadj <- layoutGetHAdjustment layout
- hpos <- adjustmentGetValue hadj
- hpage <- adjustmentGetPageSize hadj
+ hadj <- io $ layoutGetHAdjustment layout
+ hpos <- io $ adjustmentGetValue hadj
+ hpage <- io $ adjustmentGetPageSize hadj
- vadj <- layoutGetVAdjustment layout
- vpos <- adjustmentGetValue vadj
- vpage <- adjustmentGetPageSize vadj
+ vadj <- io $ layoutGetVAdjustment layout
+ vpos <- io $ adjustmentGetValue vadj
+ vpage <- io $ adjustmentGetPageSize vadj
let r = (hpos, vpos, hpos + hpage, vpos + vpage)
- win <- layoutGetDrawWindow layout
- renderWithDrawable win $ drawRegion r (canvasShowBounds canvas) shapes'
+ translate (-hpos) (-vpos)
+ drawRegion r (canvasShowBounds canvas) shapes'
canvasFocus :: Canvas a
-> IO ()
diff --git a/Bustle/UI/FilterDialog.hs b/Bustle/UI/FilterDialog.hs
index 152931e..6658d22 100644
--- a/Bustle/UI/FilterDialog.hs
+++ b/Bustle/UI/FilterDialog.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleContexts #-}
{-
Bustle.UI.FilterDialog: allows the user to filter the displayed log
Copyright © 2011 Collabora Ltd.
@@ -22,20 +23,35 @@ module Bustle.UI.FilterDialog
)
where
-import Data.List (intercalate)
+import Data.List (intercalate, groupBy, findIndices)
import qualified Data.Set as Set
import Data.Set (Set)
+import qualified Data.Function as F
import Graphics.UI.Gtk
import Bustle.Translation (__)
import Bustle.Types
+namespace :: String
+ -> (String, String)
+namespace name = case reverse (findIndices (== '.') name) of
+ [] -> ("", name)
+ (i:_) -> splitAt (i + 1) name
+
formatNames :: (UniqueName, Set OtherName)
-> String
formatNames (u, os)
| Set.null os = unUniqueName u
- | otherwise = intercalate "\n" . map unOtherName $ Set.toAscList os
+ | otherwise = intercalate "\n" . map (formatGroup . groupGroup) $ groups
+ where
+ groups = groupBy ((==) `F.on` fst) . map (namespace . unOtherName) $ Set.toAscList os
+
+ groupGroup [] = error "unpossible empty group from groupBy"
+ groupGroup xs@((ns, _):_) = (ns, map snd xs)
+
+ formatGroup (ns, [y]) = ns ++ y
+ formatGroup (ns, ys) = ns ++ "{" ++ (intercalate "," ys) ++ "}"
type NameStore = ListStore (Bool, (UniqueName, Set OtherName))
@@ -91,9 +107,11 @@ runFilterDialog :: WindowClass parent
-> IO (Set UniqueName) -- ^ The set of names to *hide*
runFilterDialog parent names currentlyHidden = do
d <- dialogNew
- windowSetTransientFor d parent
+ (windowWidth, windowHeight) <- windowGetSize parent
+ windowSetDefaultSize d (windowWidth * 7 `div` 8) (windowHeight `div` 2)
+ d `set` [ windowTransientFor := parent ]
dialogAddButton d stockClose ResponseClose
- vbox <- dialogGetUpper d
+ vbox <- fmap castToBox $ dialogGetContentArea d
boxSetSpacing vbox 6
nameStore <- makeStore names currentlyHidden
@@ -109,7 +127,7 @@ runFilterDialog parent names currentlyHidden = do
labelSetLineWrap instructions True
boxPackStart vbox instructions PackNatural 0
- containerAdd vbox sw
+ boxPackStart vbox sw PackGrow 0
widgetShowAll vbox
_ <- dialogRun d
diff --git a/Bustle/UI/OpenTwoDialog.hs b/Bustle/UI/OpenTwoDialog.hs
index 2128a58..440abc6 100644
--- a/Bustle/UI/OpenTwoDialog.hs
+++ b/Bustle/UI/OpenTwoDialog.hs
@@ -28,6 +28,7 @@ import Control.Monad (when)
import Graphics.UI.Gtk
import Bustle.Util
+import Paths_bustle
-- Propagates changes to d1's currently-selected folder to d2, if and only if
-- d2 doesn't have a currently-selected file (otherwise, choosing a file
@@ -37,7 +38,7 @@ propagateCurrentFolder :: FileChooserClass chooser
=> chooser
-> chooser
-> IO (ConnectId chooser)
-propagateCurrentFolder d1 d2 = d1 `onCurrentFolderChanged` do
+propagateCurrentFolder d1 d2 = d1 `on` currentFolderChanged $ do
f1 <- fileChooserGetCurrentFolder d1
f2 <- fileChooserGetCurrentFolder d2
otherFile <- fileChooserGetFilename d2
@@ -48,25 +49,27 @@ propagateCurrentFolder d1 d2 = d1 `onCurrentFolderChanged` do
fileChooserSetCurrentFolder d2 (fromJust f1)
return ()
-setupOpenTwoDialog :: Builder
- -> Window
+setupOpenTwoDialog :: Window
-> (FilePath -> FilePath -> IO ())
-> IO Dialog
-setupOpenTwoDialog builder parent callback = do
+setupOpenTwoDialog parent callback = do
+ builder <- builderNew
+ builderAddFromFile builder =<< getDataFileName "data/OpenTwoDialog.ui"
+
dialog <- builderGetObject builder castToDialog "openTwoDialog"
[sessionBusChooser, systemBusChooser] <-
mapM (builderGetObject builder castToFileChooserButton)
["sessionBusChooser", "systemBusChooser"]
openTwoOpenButton <- builderGetObject builder castToButton "openTwoOpenButton"
- windowSetTransientFor dialog parent
+ dialog `set` [ windowTransientFor := parent ]
dialog `on` deleteEvent $ tryEvent $ io $ widgetHide dialog
propagateCurrentFolder sessionBusChooser systemBusChooser
propagateCurrentFolder systemBusChooser sessionBusChooser
let hideMyself = do
- widgetHideAll dialog
+ widgetHide dialog
fileChooserUnselectAll sessionBusChooser
fileChooserUnselectAll systemBusChooser
@@ -82,7 +85,7 @@ setupOpenTwoDialog builder parent callback = do
connectGeneric "file-set" False systemBusChooser updateOpenSensitivity
updateOpenSensitivity
- dialog `afterResponse` \resp -> do
+ dialog `after` response $ \resp -> do
when (resp == ResponseAccept) $ do
Just f1 <- fileChooserGetFilename sessionBusChooser
Just f2 <- fileChooserGetFilename systemBusChooser
diff --git a/Bustle/UI/Recorder.hs b/Bustle/UI/Recorder.hs
index d0546bd..989412c 100644
--- a/Bustle/UI/Recorder.hs
+++ b/Bustle/UI/Recorder.hs
@@ -27,6 +27,7 @@ import Control.Monad (when, liftM)
import Control.Concurrent.MVar
import qualified Data.Map as Map
import Data.Monoid
+import Data.Maybe (maybeToList)
import Control.Monad.State (runStateT)
import Text.Printf
@@ -95,8 +96,11 @@ recorderRun filename mwindow incoming finished = C.handle newFailed $ do
monitor <- monitorNew BusTypeSession filename
dialog <- dialogNew
- maybe (return ()) (windowSetTransientFor dialog) mwindow
- dialog `set` [ windowModal := True ]
+ dialog `set` (map (windowTransientFor :=) (maybeToList mwindow))
+ dialog `set` [ windowModal := True
+ , windowTitle := ""
+ ]
+
label <- labelNew (Nothing :: Maybe String)
labelSetMarkup label $
@@ -104,36 +108,38 @@ recorderRun filename mwindow incoming finished = C.handle newFailed $ do
loaderStateRef <- newMVar Map.empty
pendingRef <- newMVar []
let updateLabel µs body = do
- -- of course, modifyMVar and runStateT have their tuples back to front.
- m <- modifyMVar loaderStateRef $ \s -> do
- (m, s') <- runStateT (convert µs body) s
- return (s', m)
-
- case m of
- Left e -> warn e
- Right message
- | isRelevant (deEvent message) -> do
- modifyMVar_ pendingRef $ \pending -> return (message:pending)
- | otherwise -> return ()
+ -- of course, modifyMVar and runStateT have their tuples back to front.
+ m <- modifyMVar loaderStateRef $ \s -> do
+ (m, s') <- runStateT (convert µs body) s
+ return (s', m)
+
+ case m of
+ Left e -> warn e
+ Right message
+ | isRelevant (deEvent message) -> do
+ modifyMVar_ pendingRef $ \pending -> return (message:pending)
+ | otherwise -> return ()
handlerId <- monitor `on` monitorMessageLogged $ updateLabel
n <- newMVar (0 :: Int)
processor <- processBatch pendingRef n label incoming
processorId <- timeoutAdd processor 200
- bar <- progressBarNew
- pulseId <- timeoutAdd (progressBarPulse bar >> return True) 100
+ spinner <- spinnerNew
+ spinnerStart spinner
- vbox <- dialogGetUpper dialog
- boxPackStart vbox label PackGrow 0
- boxPackStart vbox bar PackNatural 0
+ vbox <- fmap castToBox $ dialogGetContentArea dialog
+ hbox <- hBoxNew False 8
+ boxPackStart hbox spinner PackNatural 0
+ boxPackStart hbox label PackGrow 0
+ boxPackStart vbox hbox PackGrow 0
dialogAddButton dialog "gtk-media-stop" ResponseClose
- dialog `afterResponse` \_ -> do
+ dialog `after` response $ \_ -> do
monitorStop monitor
signalDisconnect handlerId
- timeoutRemove pulseId
+ spinnerStop spinner
timeoutRemove processorId
-- Flush out any last messages from the queue.
processor
@@ -161,7 +167,7 @@ recorderChooseFile name mwindow callback = do
, fileChooserDoOverwriteConfirmation := True
]
- chooser `afterResponse` \resp -> do
+ chooser `after` response $ \resp -> do
when (resp == ResponseAccept) $ do
Just fn <- fileChooserGetFilename chooser
callback fn
diff --git a/Bustle/UI/Util.hs b/Bustle/UI/Util.hs
index eceab0c..7c6cdcc 100644
--- a/Bustle/UI/Util.hs
+++ b/Bustle/UI/Util.hs
@@ -41,5 +41,5 @@ displayError mwindow title mbody = do
maybeM mbody $ messageDialogSetSecondaryText dialog
- dialog `afterResponse` \_ -> widgetDestroy dialog
+ dialog `after` response $ \_ -> widgetDestroy dialog
widgetShowAll dialog
diff --git a/Bustle/VariantFormatter.hs b/Bustle/VariantFormatter.hs
index ad194e5..b31ef44 100644
--- a/Bustle/VariantFormatter.hs
+++ b/Bustle/VariantFormatter.hs
@@ -110,6 +110,7 @@ typeCode TypeDouble = "d"
typeCode TypeString = "s"
typeCode TypeSignature = "g"
typeCode TypeObjectPath = "o"
+typeCode TypeUnixFd = "h"
typeCode TypeVariant = "v"
typeCode (TypeArray t) = 'a':typeCode t
typeCode (TypeDictionary kt vt) = concat [ "a{", typeCode kt , typeCode vt, "}"]
@@ -137,6 +138,7 @@ format_Variant style v =
TypeString -> format_String . fromJust . fromVariant
TypeSignature -> format_Signature . fromJust . fromVariant
TypeObjectPath -> format_ObjectPath . fromJust . fromVariant
+ TypeUnixFd -> const "<fd>"
TypeVariant -> format_Variant VariantStyleAngleBrackets . fromJust . fromVariant
TypeArray TypeWord8 -> format_ByteArray . fromJust . fromVariant
TypeArray _ -> format_Array . fromJust . fromVariant
diff --git a/GetText.hs b/GetText.hs
new file mode 100644
index 0000000..1c27146
--- /dev/null
+++ b/GetText.hs
@@ -0,0 +1,220 @@
+-- | This library extends the Distribution with internationalization support.
+--
+-- It performs two functions:
+--
+-- * compiles and installs PO files to the specified directory
+--
+-- * tells the application where files were installed to make it able
+-- to bind them to the code
+--
+-- Each PO file will be placed to the
+-- @{datadir}\/locale\/{loc}\/LC_MESSAGES\/{domain}.mo@ where:
+--
+-- [@datadir@] Usually @prefix/share@ but could be different, depends
+-- on system.
+--
+-- [@loc@] Locale name (language code, two characters). This module
+-- supposes, that each PO file has a base name set to the proper
+-- locale, e.g. @de.po@ is the German translation of the program, so
+-- this file will be placed under @{datadir}\/locale\/de@ directory
+--
+-- [@domain@] Program domain. A unique identifier of single
+-- translational unit (program). By default domain will be set to the
+-- package name, but its name could be configured in the @.cabal@ file.
+--
+-- The module defines following @.cabal@ fields:
+--
+-- [@x-gettext-domain-name@] Name of the domain. One ofmore
+-- alphanumeric characters separated by hyphens or underlines. When
+-- not set, package name will be used.
+--
+-- [@x-gettext-po-files@] List of files with translations. Could be
+-- used a limited form of wildcards, e.g.: @x-gettext-po-files:
+-- po/*.po@
+--
+-- [@x-gettext-domain-def@] Name of the macro, in which domain name
+-- will be passed to the program. Default value is
+-- @__MESSAGE_CATALOG_DOMAIN__@
+--
+-- [@x-gettext-msg-cat-def@] Name of the macro, in which path to the
+-- message catalog will be passed to the program. Default value is
+-- @__MESSAGE_CATALOG_DIR__@
+--
+-- The last two parameters are used to send configuration data to the
+-- code during its compilation. The most common usage example is:
+--
+--
+-- > ...
+-- > prepareI18N = do
+-- > setLocale LC_ALL (Just "")
+-- > bindTextDomain __MESSAGE_CATALOG_DOMAIN__ (Just __MESSAGE_CATALOG_DIR__)
+-- > textDomain __MESSAGE_CATALOG_DOMAIN__
+-- >
+-- > main = do
+-- > prepareI18N
+-- > ...
+-- >
+-- > ...
+--
+--
+-- /NOTE:/ files, passed in the @x-gettext-po-files@ are not
+-- automatically added to the source distribution, so they should be
+-- also added to the @extra-source-files@ parameter, along with
+-- translation template file (usually @message.pot@)
+--
+-- /WARNING:/ sometimes, when only configuration targets changes, code
+-- will not recompile, thus you should execute @cabal clean@ to
+-- cleanup the build and restart it again from the configuration. This
+-- is temporary bug, it will be fixed in next releases.
+--
+-- /TODO:/ this is lifted verbatim (modulo other /TODO/s) from hgettext's
+-- Distribution.Simple.I18N.GetText partly to expose individual hooks and
+-- partly to avoid the /cabal configure/-time dependency. For the latter,
+-- see https://github.com/fpco/stackage/issues/746
+--
+
+module GetText
+ (
+ -- | /TODO:/ upstream exporting the individual hooks?
+ installPOFiles,
+
+ -- | /TODO:/ upstream generating GetText_foo.hs rather than exporting these?
+ getDomainNameDefault,
+ getPackageName,
+ targetDataDir,
+
+ installGetTextHooks,
+ gettextDefaultMain
+ ) where
+
+import Distribution.Simple
+import Distribution.Simple.Setup as S
+import Distribution.Simple.LocalBuildInfo
+import Distribution.PackageDescription
+import Distribution.Simple.Configure
+import Distribution.Simple.InstallDirs as I
+import Distribution.Simple.Utils
+
+import Language.Haskell.Extension
+
+import Control.Monad
+import Control.Arrow (second)
+import Data.Maybe (listToMaybe, maybeToList, fromMaybe)
+import Data.List (unfoldr,nub,null)
+import System.FilePath
+import System.Directory
+import System.Process
+
+-- | Default main function, same as
+--
+-- > defaultMainWithHooks $ installGetTextHooks simpleUserHooks
+--
+gettextDefaultMain :: IO ()
+gettextDefaultMain = defaultMainWithHooks $ installGetTextHooks simpleUserHooks
+
+-- | Installs hooks, used by GetText module to install
+-- PO files to the system. Previous won't be disabled
+--
+installGetTextHooks :: UserHooks -- ^ initial user hooks
+ -> UserHooks -- ^ patched user hooks
+installGetTextHooks uh = uh{
+ confHook = \a b ->
+ (confHook uh) a b >>=
+ return . updateLocalBuildInfo,
+
+ postInst = \a b c d ->
+ (postInst uh) a b c d >>
+ installPOFiles a b c d
+ }
+
+
+updateLocalBuildInfo :: LocalBuildInfo -> LocalBuildInfo
+updateLocalBuildInfo l =
+ let sMap = getCustomFields l
+ [domDef, catDef] = map ($ sMap) [getDomainDefine, getMsgCatalogDefine]
+ dom = getDomainNameDefault sMap (getPackageName l)
+ tar = targetDataDir l
+ [catMS, domMS] = map (uncurry formatMacro) [(domDef, dom), (catDef, tar)]
+ in (appendCPPOptions [domMS,catMS] . appendExtension [EnableExtension CPP]) l
+
+installPOFiles :: Args -> InstallFlags -> PackageDescription -> LocalBuildInfo -> IO ()
+installPOFiles _ _ _ l =
+ let sMap = getCustomFields l
+ destDir = targetDataDir l
+ dom = getDomainNameDefault sMap (getPackageName l)
+ installFile file = do
+ let fname = takeFileName file
+ let bname = takeBaseName fname
+ let targetDir = destDir </> bname </> "LC_MESSAGES"
+ -- ensure we have directory destDir/{loc}/LC_MESSAGES
+ createDirectoryIfMissing True targetDir
+ system $ "msgfmt --output-file=" ++
+ (targetDir </> dom <.> "mo") ++
+ " " ++ file
+ in do
+ filelist <- getPoFilesDefault sMap
+ -- copy all whose name is in the form of dir/{loc}.po to the
+ -- destDir/{loc}/LC_MESSAGES/dom.mo
+ -- with the 'msgfmt' tool
+ mapM_ installFile filelist
+
+forBuildInfo :: LocalBuildInfo -> (BuildInfo -> BuildInfo) -> LocalBuildInfo
+forBuildInfo l f =
+ let a = l{localPkgDescr = updPkgDescr (localPkgDescr l)}
+ updPkgDescr x = x{library = updLibrary (library x),
+ executables = updExecs (executables x)}
+ updLibrary Nothing = Nothing
+ updLibrary (Just x) = Just $ x{libBuildInfo = f (libBuildInfo x)}
+ updExecs x = map updExec x
+ updExec x = x{buildInfo = f (buildInfo x)}
+ in a
+
+appendExtension :: [Extension] -> LocalBuildInfo -> LocalBuildInfo
+appendExtension exts l =
+ forBuildInfo l updBuildInfo
+ where updBuildInfo x = x{defaultExtensions = updExts (defaultExtensions x)}
+ updExts s = nub (s ++ exts)
+
+appendCPPOptions :: [String] -> LocalBuildInfo -> LocalBuildInfo
+appendCPPOptions opts l =
+ forBuildInfo l updBuildInfo
+ where updBuildInfo x = x{cppOptions = updOpts (cppOptions x)}
+ updOpts s = nub (s ++ opts)
+
+formatMacro name value = "-D" ++ name ++ "=" ++ (show value)
+
+targetDataDir :: LocalBuildInfo -> FilePath
+targetDataDir l =
+ let dirTmpls = installDirTemplates l
+ prefix' = prefix dirTmpls
+ data' = datadir dirTmpls
+ dataEx = I.fromPathTemplate $ I.substPathTemplate [(PrefixVar, prefix')] data'
+ in dataEx ++ "/locale"
+
+getPackageName :: LocalBuildInfo -> String
+getPackageName = fromPackageName . packageName . localPkgDescr
+ where fromPackageName (PackageName s) = s
+
+getCustomFields :: LocalBuildInfo -> [(String, String)]
+getCustomFields = customFieldsPD . localPkgDescr
+
+findInParametersDefault :: [(String, String)] -> String -> String -> String
+findInParametersDefault al name def = (fromMaybe def . lookup name) al
+
+getDomainNameDefault :: [(String, String)] -> String -> String
+getDomainNameDefault al d = findInParametersDefault al "x-gettext-domain-name" d
+
+getDomainDefine :: [(String, String)] -> String
+getDomainDefine al = findInParametersDefault al "x-gettext-domain-def" "__MESSAGE_CATALOG_DOMAIN__"
+
+getMsgCatalogDefine :: [(String, String)] -> String
+getMsgCatalogDefine al = findInParametersDefault al "x-gettext-msg-cat-def" "__MESSAGE_CATALOG_DIR__"
+
+getPoFilesDefault :: [(String, String)] -> IO [String]
+getPoFilesDefault al = toFileList $ findInParametersDefault al "x-gettext-po-files" ""
+ where toFileList "" = return []
+ toFileList x = liftM concat $ mapM matchFileGlob $ split' x
+ -- from Blow your mind (HaskellWiki)
+ -- splits string by newline, space and comma
+ split' x = concatMap lines $ concatMap words $ unfoldr (\b -> fmap (const . (second $ drop 1) . break (==',') $ b) . listToMaybe $ b) x
+
diff --git a/LICENSE.bundled-libraries b/LICENSE.bundled-libraries
index 470e61d..adf49c3 100644
--- a/LICENSE.bundled-libraries
+++ b/LICENSE.bundled-libraries
@@ -1,6 +1,6 @@
Shipping these libraries in the tarball is monstrous, and I'm sorry. I just
wanted to ship this thing. Anyway, these libraries are slurped right out of the
-Debian packages on the system the tarball was built on. Here are some licenses:
+OS packages on the system the tarball was built on. Here are some licenses:
libffi:
@@ -68,7 +68,7 @@ libgmp:
You should have received a copy of the GNU Lesser General Public License
along with the GNU MP Library. If not, see http://www.gnu.org/licenses/.
-The source code is available from http://willthompson.co.uk/bustle/releases/.
+The source code is available from http://www.freedesktop.org/software/bustle/
Your complimentary copy of the GNU Lesser General Public License follows:
GNU LESSER GENERAL PUBLIC LICENSE
diff --git a/Makefile b/Makefile
index 918aa3c..459b2f2 100644
--- a/Makefile
+++ b/Makefile
@@ -29,7 +29,7 @@ BUSTLE_PCAP_GENERATED_HEADERS = dist/build/autogen/version.h
BUSTLE_PCAP_HEADERS = c-sources/pcap-monitor.h $(BUSTLE_PCAP_GENERATED_HEADERS)
bustle-pcap.1: dist/build/bustle-pcap
- -help2man --output=$@ --no-info --name='Generate D-Bus logs for bustle' $<
+ help2man --output=$@ --no-info --name='Generate D-Bus logs for bustle' $<
bustle.desktop: data/bustle.desktop.in
LC_ALL=C intltool-merge -d -u po $< $@
@@ -43,11 +43,14 @@ dist/build/bustle-pcap: $(BUSTLE_PCAP_SOURCES) $(BUSTLE_PCAP_HEADERS)
-o $@ $(BUSTLE_PCAP_SOURCES) \
$(GIO_FLAGS) $(PCAP_FLAGS)
-dist/build/autogen/version.h: bustle.cabal
+dist/build/autogen/version.txt: bustle.cabal
@mkdir -p `dirname $@`
- perl -nle 'm/^Version:\s+(.*)$$/ and print qq(#define BUSTLE_VERSION "$$1")' \
+ perl -nle 'm/^Version:\s+(.*)$$/ and print $$1' \
$< > $@
+dist/build/autogen/version.h: dist/build/autogen/version.txt
+ echo '#define BUSTLE_VERSION "'`cat $<`'"' > $@
+
install: all
mkdir -p $(BINDIR)
cp $(BINARIES) $(BINDIR)
@@ -97,7 +100,7 @@ TARBALL_FULL_DIR := $(TARBALL_PARENT_DIR)/$(TARBALL_DIR)
TARBALL := $(TARBALL_DIR).tar.bz2
maintainer-binary-tarball: all
mkdir -p $(TARBALL_FULL_DIR)
- cabal-dev install --prefix=$(TOP)/$(TARBALL_FULL_DIR) \
+ cabal install --prefix=$(TOP)/$(TARBALL_FULL_DIR) \
--datadir=$(TOP)/$(TARBALL_FULL_DIR) --datasubdir=.
cp bustle.sh README.md $(TARBALL_FULL_DIR)
perl -pi -e 's{^ bustle-pcap}{ ./bustle-pcap};' \
@@ -109,13 +112,17 @@ maintainer-binary-tarball: all
./ldd-me-up.sh $(TARBALL_FULL_DIR)/bin/bustle \
| xargs -I XXX cp XXX $(TARBALL_FULL_DIR)/lib
cd $(TARBALL_PARENT_DIR) && tar cjf $(TARBALL) $(TARBALL_DIR)
+ rm -r $(TARBALL_FULL_DIR)
maintainer-update-messages-pot:
find Bustle -name '*.hs' -print0 | xargs -0 hgettext -k __ -o po/messages.pot
-maintainer-make-release: bustle.cabal
+maintainer-make-release: bustle.cabal dist/build/autogen/version.txt
cabal test
cabal sdist
- git tag -s -m 'Bustle '`perl -nle 'm/^Version:\s+(.*)$$/ and print qq($$1)' bustle.cabal` \
- bustle-`perl -nle 'm/^Version:\s+(.*)$$/ and print qq($$1)' bustle.cabal`
+ git tag -s -m 'Bustle '`cat dist/build/autogen/version.txt` \
+ bustle-`cat dist/build/autogen/version.txt`
make maintainer-binary-tarball
+
+.travis.yml: bustle.cabal make_travis_yml.hs
+ ./make_travis_yml.hs $< libpcap-dev libgtk-3-dev libcairo2-dev happy-1.19.4 alex-3.1.3 > $@
diff --git a/NEWS.md b/NEWS.md
index b1b417e..fced0fa 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,3 +1,25 @@
+Bustle 0.5.2 (2015-08-18)
+-------------------------
+
+* No functional changes!
+* Update all links to <http://www.freedesktop.org/wiki/Software/Bustle/>
+* Remove external dependencies from Cabal build script for the benefit
+ of Stackage and Travis-CI. <https://github.com/fpco/stackage/issues/746>
+
+Bustle 0.5.1 (2015-06-28)
+-------------------------
+
+* Build fixes for GHC 7.10 (Sergei Trofimovich)
+
+Bustle 0.5.0 (2015-06-04)
+-------------------------
+
+* Use Gtk+ 3, making Bustle more beautiful and support hidpi displays.
+* Fix warnings triggered by recent GHCs and standard libraries by
+ completely mechanical patching.
+* Try not to crash if you view the body of a message containing a Unix
+ FD.
+
Bustle 0.4.8 (2015-03-22)
-------------------------
@@ -186,8 +208,8 @@ there will be more interesting stuff in the next release.
While we're here, Bustle's git repository has moved to freedesktop.org,
and it now has a bug tracker there too. Browse the source at
<http://cgit.freedesktop.org/bustle/>; see open bugs at
-<http://wjt.me.uk/bustle/bugs>; file new ones at
-<http://wjt.me.uk/bustle/new-bug>. Astonishing!
+<https://bugs.freedesktop.org/buglist.cgi?bug_status=NEW&bug_status=ASSIGNED&bug_status=REOPENED&list_id=549676&product=Bustle&query_format=advanced>; file new ones at
+<https://bugs.freedesktop.org/enter_bug.cgi?product=Bustle>. Astonishing!
* The viewer is now much more tolerant of inconsistencies in log files.
(Thanks to Marco Barisione for the [bug report][fdo35297].)
diff --git a/README.md b/README.md
index 8ea69c5..c93c3da 100644
--- a/README.md
+++ b/README.md
@@ -44,4 +44,4 @@ Please remember to **undo these changes** when you're done.
More information
================
-See <http://wjt.me.uk/bustle/>.
+See <http://www.freedesktop.org/wiki/Software/Bustle/>.
diff --git a/Setup.hs b/Setup.hs
index 9ab758c..d067f7e 100644
--- a/Setup.hs
+++ b/Setup.hs
@@ -1,11 +1,9 @@
{-# OPTIONS_GHC -Wall #-}
-import Data.Maybe (fromMaybe)
import System.FilePath ( (</>), (<.>) )
import Distribution.PackageDescription
import Distribution.Simple
import Distribution.Simple.BuildPaths ( autogenModulesDir )
-import Distribution.Simple.InstallDirs as I
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.Setup as S
import Distribution.Simple.Utils
@@ -14,7 +12,7 @@ import Distribution.Text ( display )
import Distribution.ModuleName (ModuleName)
import qualified Distribution.ModuleName as ModuleName
-import qualified Distribution.Simple.I18N.GetText as GetText
+import qualified GetText as GetText
main :: IO ()
main = defaultMainWithHooks $ installBustleHooks simpleUserHooks
@@ -31,13 +29,13 @@ main = defaultMainWithHooks $ installBustleHooks simpleUserHooks
installBustleHooks :: UserHooks
-> UserHooks
installBustleHooks uh = uh
- { postInst = postInst gtuh
+ { postInst = \a b c d -> do
+ postInst uh a b c d
+ GetText.installPOFiles a b c d
, buildHook = \pkg lbi hooks flags -> do
writeGetTextConstantsFile pkg lbi flags
buildHook uh pkg lbi hooks flags
}
- where
- gtuh = GetText.installGetTextHooks uh
writeGetTextConstantsFile :: PackageDescription -> LocalBuildInfo -> BuildFlags -> IO ()
@@ -90,24 +88,7 @@ generateModule pkg lbi =
"getMessageCatalogDir = catchIO (getEnv \"" ++ fixedPackageName pkg ++ "_localedir\") (\\_ -> return messageCatalogDir)\n"
sMap = customFieldsPD (localPkgDescr lbi)
- dom = getDomainNameDefault sMap (getPackageName lbi)
- tar = targetDataDir lbi
+ dom = GetText.getDomainNameDefault sMap (GetText.getPackageName lbi)
+ tar = GetText.targetDataDir lbi
-- Cargo-culted from hgettext
-findInParametersDefault :: [(String, String)] -> String -> String -> String
-findInParametersDefault al name def = (fromMaybe def . lookup name) al
-
-getPackageName :: LocalBuildInfo -> String
-getPackageName = fromPackageName . packageName . localPkgDescr
- where fromPackageName (PackageName s) = s
-
-getDomainNameDefault :: [(String, String)] -> String -> String
-getDomainNameDefault al d = findInParametersDefault al "x-gettext-domain-name" d
-
-targetDataDir :: LocalBuildInfo -> FilePath
-targetDataDir l =
- let dirTmpls = installDirTemplates l
- prefix' = prefix dirTmpls
- data' = datadir dirTmpls
- dataEx = I.fromPathTemplate $ I.substPathTemplate [(PrefixVar, prefix')] data'
- in dataEx ++ "/locale"
diff --git a/Test/Regions.hs b/Test/Regions.hs
index a6c6076..d4b46b0 100644
--- a/Test/Regions.hs
+++ b/Test/Regions.hs
@@ -171,6 +171,9 @@ prop_FlattenThenNewIsIdempotent vr@(ValidRegions regions) =
withRegions vr $ \rs -> property $
regionSelectionNew (regionSelectionFlatten rs) == rs
+-- Essential scary hack to make quickCheckAll work O_o
+-- https://hackage.haskell.org/package/QuickCheck-2.7.6/docs/Test-QuickCheck-All.html
+return []
runTests = $quickCheckAll
main = do
diff --git a/Test/Renderer.hs b/Test/Renderer.hs
index a760b5a..08fac5a 100644
--- a/Test/Renderer.hs
+++ b/Test/Renderer.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleContexts #-}
module Main where
import Test.Framework (defaultMain, testGroup)
diff --git a/bustle.cabal b/bustle.cabal
index 249bc99..c6c79c0 100644
--- a/bustle.cabal
+++ b/bustle.cabal
@@ -1,16 +1,19 @@
Name: bustle
Category: Network, Desktop
-Version: 0.4.8
-Cabal-Version: >= 1.8
+Version: 0.5.2
+Cabal-Version: >= 1.18
+Tested-With: GHC >= 7.8.4 && < 7.11
Synopsis: Draw sequence diagrams of D-Bus traffic
Description: Draw sequence diagrams of D-Bus traffic
License: OtherLicense
License-file: LICENSE
Author: Will Thompson <will at willthompson.co.uk>
Maintainer: Will Thompson <will at willthompson.co.uk>
+Homepage: http://www.freedesktop.org/wiki/Software/Bustle/
Data-files: data/dfeet-method.png,
data/dfeet-signal.png,
data/bustle.ui,
+ data/OpenTwoDialog.ui,
LICENSE
Build-type: Custom
Extra-source-files:
@@ -33,6 +36,10 @@ Extra-source-files:
, ldd-me-up.sh
, LICENSE.bundled-libraries
+ -- inlined copy of the Cabal hooks from hgettext;
+ -- see https://github.com/fpco/stackage/issues/746
+ , GetText.hs
+
-- wow many translate
, po/*.po
, po/*.pot
@@ -65,6 +72,13 @@ Flag threaded
Description: Build with the multi-threaded runtime
Default: True
+Flag WithGtk2HsBuildTools
+ Description: Build-depend on gtk2hs-buildtools. They aren't (currently)
+ used to build Bustle itself but are needed to build
+ dependencies like gtk3, which for whatever reason do not
+ Build-Depend on the tools.
+ Default: False
+
Executable bustle
Main-is: Bustle.hs
Other-modules: Bustle.Application.Monad
@@ -92,13 +106,14 @@ Executable bustle
, Bustle.Upgrade
, Bustle.Util
, Bustle.VariantFormatter
+ default-language: Haskell2010
Ghc-options: -Wall
-fno-warn-unused-do-bind
if flag(threaded)
ghc-options: -threaded
C-sources: c-sources/pcap-monitor.c
+ cc-options: -fPIC
pkgconfig-depends: glib-2.0 >= 2.26
-
Build-Depends: base >= 4 && < 5
, bytestring
, cairo
@@ -107,9 +122,10 @@ Executable bustle
, directory
, filepath
, glib
- , gtk >= 0.12.4
+ , gio
+ , gtk3
, hgettext >= 0.1.5
- , mtl
+ , mtl >= 2.2.1
, pango
, parsec
, pcap
@@ -118,6 +134,9 @@ Executable bustle
, text
, time
+ if flag(WithGtk2HsBuildTools)
+ Build-Depends: gtk2hs-buildtools
+
Executable test-monitor
if flag(InteractiveTests)
buildable: True
@@ -126,9 +145,11 @@ Executable test-monitor
main-is: tests/Monitor.hs
other-modules: Bustle.Monitor
+ default-language: Haskell2010
if flag(threaded)
Ghc-options: -threaded
C-sources: c-sources/pcap-monitor.c
+ cc-options: -fPIC
pkgconfig-depends: glib-2.0
Build-Depends: base >= 4 && < 5
, bytestring
@@ -137,7 +158,8 @@ Executable test-monitor
, dbus
, directory
, filepath
- , gtk > 0.12
+ -- 0.13.6 doesn't compile with GCC 5: https://github.com/gtk2hs/gtk2hs/issues/104
+ , gtk3 >= 0.13.7
, glib
, hgettext
, mtl
@@ -154,6 +176,7 @@ Executable dump-messages
buildable: False
main-is: Test/DumpMessages.hs
+ default-language: Haskell2010
Build-Depends: base
, bytestring
, containers
@@ -166,6 +189,7 @@ Test-suite test-pcap-crash
type: exitcode-stdio-1.0
main-is: Test/PcapCrash.hs
other-modules: Bustle.Loader.Pcap
+ default-language: Haskell2010
Build-Depends: base
, bytestring
, containers
@@ -185,13 +209,14 @@ Test-suite test-renderer
type: exitcode-stdio-1.0
main-is: Test/Renderer.hs
other-modules: Bustle.Renderer
+ default-language: Haskell2010
Build-Depends: base
, cairo
, containers
, dbus >= 0.10
, directory
, filepath
- , gtk
+ , gtk3
, mtl
, text
, pango
diff --git a/data/OpenTwoDialog.ui b/data/OpenTwoDialog.ui
new file mode 100644
index 0000000..463d5e7
--- /dev/null
+++ b/data/OpenTwoDialog.ui
@@ -0,0 +1,133 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<interface>
+ <!-- interface-requires gtk+ 3.0 -->
+ <object class="GtkDialog" id="openTwoDialog">
+ <property name="can_focus">False</property>
+ <property name="border_width">5</property>
+ <property name="title" translatable="yes">Open a Pair of Logs</property>
+ <property name="resizable">False</property>
+ <property name="modal">True</property>
+ <property name="type_hint">dialog</property>
+ <property name="icon-name">bustle</property>
+ <child internal-child="vbox">
+ <object class="GtkBox" id="dialog-vbox1">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="orientation">vertical</property>
+ <property name="spacing">2</property>
+ <child internal-child="action_area">
+ <object class="GtkButtonBox" id="dialog-action_area1">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="layout_style">end</property>
+ <child>
+ <object class="GtkButton" id="openTwoCancelButton">
+ <property name="label">gtk-cancel</property>
+ <property name="use_action_appearance">False</property>
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">True</property>
+ <property name="use_action_appearance">False</property>
+ <property name="use_stock">True</property>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="openTwoOpenButton">
+ <property name="label">gtk-open</property>
+ <property name="use_action_appearance">False</property>
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">True</property>
+ <property name="use_action_appearance">False</property>
+ <property name="use_stock">True</property>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">1</property>
+ </packing>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">True</property>
+ <property name="pack_type">end</property>
+ <property name="position">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkTable" id="table1">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="n_rows">2</property>
+ <property name="n_columns">2</property>
+ <property name="column_spacing">6</property>
+ <property name="row_spacing">6</property>
+ <child>
+ <object class="GtkFileChooserButton" id="systemBusChooser">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="title" translatable="yes">Select system bus log</property>
+ <property name="width_chars">30</property>
+ </object>
+ <packing>
+ <property name="left_attach">1</property>
+ <property name="right_attach">2</property>
+ <property name="top_attach">1</property>
+ <property name="bottom_attach">2</property>
+ <property name="y_options"></property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkLabel" id="label44">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="xalign">0</property>
+ <property name="label" translatable="yes">System bus log:</property>
+ </object>
+ <packing>
+ <property name="top_attach">1</property>
+ <property name="bottom_attach">2</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkLabel" id="label55">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="xalign">0</property>
+ <property name="label" translatable="yes">Session bus log:</property>
+ </object>
+ </child>
+ <child>
+ <object class="GtkFileChooserButton" id="sessionBusChooser">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="title" translatable="yes">Select session bus log</property>
+ <property name="width_chars">30</property>
+ </object>
+ <packing>
+ <property name="left_attach">1</property>
+ <property name="right_attach">2</property>
+ <property name="y_options">GTK_EXPAND</property>
+ </packing>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">True</property>
+ <property name="position">1</property>
+ </packing>
+ </child>
+ </object>
+ </child>
+ <action-widgets>
+ <action-widget response="-6">openTwoCancelButton</action-widget>
+ <action-widget response="-3">openTwoOpenButton</action-widget>
+ </action-widgets>
+ </object>
+</interface>
diff --git a/data/bustle.ui b/data/bustle.ui
index 626feb1..0214fa3 100644
--- a/data/bustle.ui
+++ b/data/bustle.ui
@@ -7,173 +7,110 @@
<property name="default_height">700</property>
<property name="icon-name">bustle</property>
<property name="title" translatable="yes">Bustle</property>
+ <child type="titlebar">
+ <object class="GtkHeaderBar" id="header">
+ <property name="visible">True</property>
+ <property name="show-close-button">True</property>
+
+ <child>
+ <object class="GtkMenuButton" id="headerOpen">
+ <property name="visible">True</property>
+ <property name="sensitive">True</property>
+ <property name="tooltip_text" translatable="yes">Open an existing log</property>
+ <property name="popup">openMenu</property>
+ <style>
+ <class name="image-button"/>
+ </style>
+ <child>
+ <object class="GtkImage">
+ <property name="visible">True</property>
+ <property name="icon-name">document-open-symbolic</property>
+ <property name="icon-size">1</property>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="pack-type">GTK_PACK_START</property>
+ </packing>
+ </child>
+
+ <!-- TODO: media-record-symbolic -->
+ <child>
+ <object class="GtkButton" id="headerNew">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">Record</property>
+ <property name="tooltip_text" translatable="yes">Record a new log</property>
+ </object>
+ </child>
+
+ <child>
+ <object class="GtkMenuButton">
+ <property name="visible">True</property>
+ <property name="popup">filterStatsEtc</property>
+ <style>
+ <class name="image-button"/>
+ </style>
+ <child>
+ <object class="GtkImage">
+ <property name="visible">True</property>
+ <property name="icon-name">open-menu-symbolic</property>
+ <property name="icon-size">1</property>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="pack-type">end</property>
+ </packing>
+ </child>
+
+ <child>
+ <object class="GtkButton" id="headerExport">
+ <property name="visible">True</property>
+ <property name="sensitive">False</property>
+ <property name="tooltip_text" translatable="yes">Export as PDF</property>
+ <style>
+ <class name="image-button"/>
+ </style>
+ <child>
+ <object class="GtkImage">
+ <property name="visible">True</property>
+ <property name="icon-name">document-send-symbolic</property>
+ <property name="icon-size">1</property>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="pack-type">end</property>
+ </packing>
+ </child>
+
+ <child>
+ <object class="GtkButton" id="headerSave">
+ <property name="visible">True</property>
+ <property name="sensitive">False</property>
+ <property name="tooltip_text" translatable="yes">Save</property>
+ <style>
+ <class name="image-button"/>
+ </style>
+ <child>
+ <object class="GtkImage">
+ <property name="visible">True</property>
+ <property name="icon-name">document-save-symbolic</property>
+ <property name="icon-size">1</property>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="pack-type">end</property>
+ </packing>
+ </child>
+ </object>
+ </child>
<child>
<object class="GtkVBox" id="box1">
<property name="visible">True</property>
<property name="can_focus">False</property>
<child>
- <object class="GtkMenuBar" id="menubar1">
- <property name="visible">True</property>
- <property name="can_focus">False</property>
- <child>
- <object class="GtkMenuItem" id="menuitem1">
- <property name="use_action_appearance">False</property>
- <property name="visible">True</property>
- <property name="can_focus">False</property>
- <property name="label" translatable="yes">_File</property>
- <property name="use_underline">True</property>
- <child type="submenu">
- <object class="GtkMenu" id="menu1">
- <property name="visible">True</property>
- <property name="can_focus">False</property>
- <child>
- <object class="GtkImageMenuItem" id="new">
- <property name="label">gtk-new</property>
- <property name="use_action_appearance">False</property>
- <property name="visible">True</property>
- <property name="can_focus">False</property>
- <property name="use_underline">True</property>
- <property name="use_stock">True</property>
- <accelerator key="n" signal="activate" modifiers="GDK_CONTROL_MASK"/>
- </object>
- </child>
- <child>
- <object class="GtkImageMenuItem" id="open">
- <property name="label">gtk-open</property>
- <property name="use_action_appearance">False</property>
- <property name="visible">True</property>
- <property name="can_focus">False</property>
- <property name="use_underline">True</property>
- <property name="use_stock">True</property>
- <accelerator key="o" signal="activate" modifiers="GDK_CONTROL_MASK"/>
- </object>
- </child>
- <child>
- <object class="GtkMenuItem" id="openTwo">
- <property name="use_action_appearance">False</property>
- <property name="visible">True</property>
- <property name="can_focus">False</property>
- <property name="tooltip_text" translatable="yes">Display two logs—one for the session bus, one for the system bus—side by side.</property>
- <property name="label" translatable="yes">O_pen a Pair of Logs…</property>
- <property name="use_underline">True</property>
- </object>
- </child>
- <child>
- <object class="GtkImageMenuItem" id="save">
- <property name="label">gtk-save-as</property>
- <property name="use_action_appearance">False</property>
- <property name="visible">True</property>
- <property name="sensitive">False</property>
- <property name="can_focus">False</property>
- <property name="use_underline">True</property>
- <property name="use_stock">True</property>
- <accelerator key="s" signal="activate" modifiers="GDK_CONTROL_MASK"/>
- </object>
- </child>
- <child>
- <object class="GtkMenuItem" id="export">
- <property name="use_action_appearance">False</property>
- <property name="visible">True</property>
- <property name="sensitive">False</property>
- <property name="can_focus">False</property>
- <property name="label" translatable="yes">_Export as PDF…</property>
- <property name="use_underline">True</property>
- <accelerator key="s" signal="activate" modifiers="GDK_SHIFT_MASK | GDK_CONTROL_MASK"/>
- </object>
- </child>
- <child>
- <object class="GtkSeparatorMenuItem" id="separatormenuitem1">
- <property name="use_action_appearance">False</property>
- <property name="visible">True</property>
- <property name="can_focus">False</property>
- </object>
- </child>
- <child>
- <object class="GtkImageMenuItem" id="close">
- <property name="label">gtk-close</property>
- <property name="use_action_appearance">False</property>
- <property name="visible">True</property>
- <property name="sensitive">True</property>
- <property name="can_focus">False</property>
- <property name="use_underline">True</property>
- <property name="use_stock">True</property>
- <accelerator key="w" signal="activate" modifiers="GDK_CONTROL_MASK"/>
- </object>
- </child>
- </object>
- </child>
- </object>
- </child>
- <child>
- <object class="GtkMenuItem" id="menuitem3">
- <property name="use_action_appearance">False</property>
- <property name="visible">True</property>
- <property name="can_focus">False</property>
- <property name="label" translatable="yes">_View</property>
- <property name="use_underline">True</property>
- <child type="submenu">
- <object class="GtkMenu" id="menu2">
- <property name="visible">True</property>
- <property name="can_focus">False</property>
- <child>
- <object class="GtkMenuItem" id="filter">
- <property name="use_action_appearance">False</property>
- <property name="visible">True</property>
- <property name="sensitive">False</property>
- <property name="can_focus">False</property>
- <property name="label" translatable="yes">_Filter Visible Services…</property>
- <property name="use_underline">True</property>
- <accelerator key="f" signal="activate" modifiers="GDK_CONTROL_MASK"/>
- </object>
- </child>
- <child>
- <object class="GtkCheckMenuItem" id="statistics">
- <property name="use_action_appearance">False</property>
- <property name="visible">True</property>
- <property name="sensitive">False</property>
- <property name="can_focus">False</property>
- <property name="label" translatable="yes">_Statistics</property>
- <property name="use_underline">True</property>
- <accelerator key="F9" signal="activate"/>
- </object>
- </child>
- </object>
- </child>
- </object>
- </child>
- <child>
- <object class="GtkMenuItem" id="menuitem4">
- <property name="use_action_appearance">False</property>
- <property name="visible">True</property>
- <property name="can_focus">False</property>
- <property name="label" translatable="yes">_Help</property>
- <property name="use_underline">True</property>
- <child type="submenu">
- <object class="GtkMenu" id="menu3">
- <property name="visible">True</property>
- <property name="can_focus">False</property>
- <child>
- <object class="GtkImageMenuItem" id="about">
- <property name="label">gtk-about</property>
- <property name="use_action_appearance">False</property>
- <property name="visible">True</property>
- <property name="can_focus">False</property>
- <property name="use_underline">True</property>
- <property name="use_stock">True</property>
- </object>
- </child>
- </object>
- </child>
- </object>
- </child>
- </object>
- <packing>
- <property name="expand">False</property>
- <property name="fill">True</property>
- <property name="position">0</property>
- </packing>
- </child>
- <child>
<object class="GtkNotebook" id="diagramOrNot">
<property name="visible">True</property>
<property name="can_focus">True</property>
@@ -491,133 +428,75 @@
</object>
</child>
</object>
- <object class="GtkDialog" id="openTwoDialog">
- <property name="can_focus">False</property>
- <property name="border_width">5</property>
- <property name="title" translatable="yes">Open a Pair of Logs</property>
- <property name="resizable">False</property>
- <property name="modal">True</property>
- <property name="type_hint">dialog</property>
- <property name="icon-name">bustle</property>
- <child internal-child="vbox">
- <object class="GtkBox" id="dialog-vbox1">
- <property name="visible">True</property>
- <property name="can_focus">False</property>
- <property name="orientation">vertical</property>
- <property name="spacing">2</property>
- <child internal-child="action_area">
- <object class="GtkButtonBox" id="dialog-action_area1">
- <property name="visible">True</property>
- <property name="can_focus">False</property>
- <property name="layout_style">end</property>
- <child>
- <object class="GtkButton" id="openTwoCancelButton">
- <property name="label">gtk-cancel</property>
- <property name="use_action_appearance">False</property>
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="receives_default">True</property>
- <property name="use_action_appearance">False</property>
- <property name="use_stock">True</property>
- </object>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">0</property>
- </packing>
- </child>
- <child>
- <object class="GtkButton" id="openTwoOpenButton">
- <property name="label">gtk-open</property>
- <property name="use_action_appearance">False</property>
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="receives_default">True</property>
- <property name="use_action_appearance">False</property>
- <property name="use_stock">True</property>
- </object>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">1</property>
- </packing>
- </child>
- </object>
- <packing>
- <property name="expand">False</property>
- <property name="fill">True</property>
- <property name="pack_type">end</property>
- <property name="position">0</property>
- </packing>
- </child>
- <child>
- <object class="GtkTable" id="table1">
- <property name="visible">True</property>
- <property name="can_focus">False</property>
- <property name="n_rows">2</property>
- <property name="n_columns">2</property>
- <property name="column_spacing">6</property>
- <property name="row_spacing">6</property>
- <child>
- <object class="GtkFileChooserButton" id="systemBusChooser">
- <property name="visible">True</property>
- <property name="can_focus">False</property>
- <property name="title" translatable="yes">Select system bus log</property>
- <property name="width_chars">30</property>
- </object>
- <packing>
- <property name="left_attach">1</property>
- <property name="right_attach">2</property>
- <property name="top_attach">1</property>
- <property name="bottom_attach">2</property>
- <property name="y_options"></property>
- </packing>
- </child>
- <child>
- <object class="GtkLabel" id="label44">
- <property name="visible">True</property>
- <property name="can_focus">False</property>
- <property name="xalign">0</property>
- <property name="label" translatable="yes">System bus log:</property>
- </object>
- <packing>
- <property name="top_attach">1</property>
- <property name="bottom_attach">2</property>
- </packing>
- </child>
- <child>
- <object class="GtkLabel" id="label55">
- <property name="visible">True</property>
- <property name="can_focus">False</property>
- <property name="xalign">0</property>
- <property name="label" translatable="yes">Session bus log:</property>
- </object>
- </child>
- <child>
- <object class="GtkFileChooserButton" id="sessionBusChooser">
- <property name="visible">True</property>
- <property name="can_focus">False</property>
- <property name="title" translatable="yes">Select session bus log</property>
- <property name="width_chars">30</property>
- </object>
- <packing>
- <property name="left_attach">1</property>
- <property name="right_attach">2</property>
- <property name="y_options">GTK_EXPAND</property>
- </packing>
- </child>
- </object>
- <packing>
- <property name="expand">False</property>
- <property name="fill">True</property>
- <property name="position">1</property>
- </packing>
- </child>
- </object>
- </child>
- <action-widgets>
- <action-widget response="-6">openTwoCancelButton</action-widget>
- <action-widget response="-3">openTwoOpenButton</action-widget>
- </action-widgets>
- </object>
+
+ <object class="GtkMenu" id="filterStatsEtc">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="halign">end</property>
+ <child>
+ <object class="GtkMenuItem" id="filter">
+ <property name="use_action_appearance">False</property>
+ <property name="visible">True</property>
+ <property name="sensitive">False</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">_Filter Visible Services…</property>
+ <property name="use_underline">True</property>
+ <accelerator key="f" signal="activate" modifiers="GDK_CONTROL_MASK"/>
+ </object>
+ </child>
+ <child>
+ <object class="GtkCheckMenuItem" id="statistics">
+ <property name="use_action_appearance">False</property>
+ <property name="visible">True</property>
+ <property name="sensitive">False</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">_Statistics</property>
+ <property name="use_underline">True</property>
+ <accelerator key="F9" signal="activate"/>
+ </object>
+ </child>
+ <child>
+ <object class="GtkSeparatorMenuItem" id="separatormenuitem1">
+ <property name="use_action_appearance">False</property>
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ </object>
+ </child>
+ <child>
+ <object class="GtkImageMenuItem" id="about">
+ <property name="label">gtk-about</property>
+ <property name="use_action_appearance">False</property>
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="use_underline">True</property>
+ <property name="use_stock">True</property>
+ </object>
+ </child>
+ </object>
+
+ <object class="GtkMenu" id="openMenu">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <child>
+ <object class="GtkImageMenuItem" id="open">
+ <property name="label">gtk-open</property>
+ <property name="use_action_appearance">False</property>
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="use_underline">True</property>
+ <property name="use_stock">True</property>
+ <accelerator key="o" signal="activate" modifiers="GDK_CONTROL_MASK"/>
+ </object>
+ </child>
+ <child>
+ <object class="GtkMenuItem" id="openTwo">
+ <property name="use_action_appearance">False</property>
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="tooltip_text" translatable="yes">Display two logs—one for the session bus, one for the system bus—side by side.</property>
+ <property name="label" translatable="yes">O_pen a Pair of Logs…</property>
+ <property name="use_underline">True</property>
+ </object>
+ </child>
+ </object>
</interface>
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-haskell/bustle.git
More information about the Pkg-haskell-commits
mailing list