[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