[Pkg-haskell-commits] [bustle] 01/03: Imported Upstream version 0.4.8
Joachim Breitner
nomeata at moszumanska.debian.org
Fri May 22 07:46:37 UTC 2015
This is an automated email from the git hooks/post-receive script.
nomeata pushed a commit to branch master
in repository bustle.
commit 071cb1eb80477e9c221322f0a33c294b9bca663f
Author: Joachim Breitner <mail at joachim-breitner.de>
Date: Fri May 22 09:41:22 2015 +0200
Imported Upstream version 0.4.8
---
Bustle/Diagram.hs | 26 +++++---
Bustle/{Markup.hs => Marquee.hs} | 52 ++++++++--------
Bustle/StatisticsPane.hs | 34 +++++------
Bustle/UI.hs | 8 ++-
Bustle/UI/Canvas.hs | 3 +-
Bustle/UI/DetailsView.hs | 14 ++---
Bustle/UI/FilterDialog.hs | 2 +-
Bustle/UI/Recorder.hs | 10 +--
HACKING => HACKING.md | 0
INSTALL => INSTALL.md | 0
Makefile | 15 ++++-
NEWS => NEWS.md | 11 ++++
README => README.md | 0
Test/Regions.hs | 22 ++++---
bustle.cabal | 17 +++---
data/icons/scalable/bustle-symbolic.svg | 104 ++++++++++++++++++++++++++++++++
data/icons/scalable/bustle.svg | 25 ++------
17 files changed, 238 insertions(+), 105 deletions(-)
diff --git a/Bustle/Diagram.hs b/Bustle/Diagram.hs
index d558beb..f9a96b7 100644
--- a/Bustle/Diagram.hs
+++ b/Bustle/Diagram.hs
@@ -53,13 +53,13 @@ import Control.Applicative ((<$>), (<*>))
import Control.Monad.Reader
-import Graphics.Rendering.Cairo
+import Graphics.Rendering.Cairo (Operator(..), Render, arc, curveTo, fill, getCurrentPoint, lineTo, moveTo, newPath, paint, rectangle, restore, save, setDash, setLineWidth, setOperator, setSourceRGB, stroke)
import Graphics.UI.Gtk.Cairo (cairoCreateContext, showLayout)
import Graphics.Rendering.Pango.Layout
import Graphics.Rendering.Pango.Font
-import qualified Bustle.Markup as Markup
-import Bustle.Markup (Markup)
+import qualified Bustle.Marquee as Marquee
+import Bustle.Marquee (Marquee)
import Bustle.Util
import Bustle.Types (ObjectPath, InterfaceName, MemberName)
@@ -430,7 +430,7 @@ drawArc cx cy dx dy x1 y1 x2 y2 cap = saved $ do
stroke
setSourceRGB 0 0 0
- l <- mkLayout (Markup.escape cap) EllipsizeNone AlignLeft
+ l <- mkLayout (Marquee.escape cap) EllipsizeNone AlignLeft
(PangoRectangle _ _ textWidth _, _) <- liftIO $ layoutGetExtents l
let tx = min x2 dx + abs (x2 - dx) / 2
moveTo (if x1 > cx then tx - textWidth else tx) (y2 - 5)
@@ -445,12 +445,18 @@ font = unsafePerformIO $ do
{-# NOINLINE font #-}
mkLayout :: (MonadIO m)
- => Markup -> EllipsizeMode -> LayoutAlignment
+ => Marquee -> EllipsizeMode -> LayoutAlignment
-> m PangoLayout
mkLayout s e a = liftIO $ do
ctx <- cairoCreateContext Nothing
layout <- layoutEmpty ctx
- layoutSetMarkup layout (Markup.unMarkup s)
+ -- layoutSetMarkup returns the un-marked-up text. We don't care about it,
+ -- but recent versions of Pango give it the type
+ -- GlibString string => ... -> IO string
+ -- which we need to disambiguate between Text and String. Old versions were
+ -- .. -> IO String
+ -- so go with that.
+ layoutSetMarkup layout (Marquee.toPangoMarkup s) :: IO String
layoutSetFontDescription layout (Just font)
layoutSetEllipsize layout e
layoutSetAlignment layout a
@@ -464,7 +470,7 @@ withWidth m w = do
drawHeader :: [String] -> Double -> Double -> Render ()
drawHeader names x y = forM_ (zip [0..] names) $ \(i, name) -> do
- l <- mkLayout (Markup.escape name) EllipsizeEnd AlignCenter `withWidth` columnWidth
+ l <- mkLayout (Marquee.escape name) EllipsizeEnd AlignCenter `withWidth` columnWidth
moveTo (x - (columnWidth / 2)) (y + i * h)
showLayout l
where h = 10
@@ -485,14 +491,14 @@ drawMember p i m isReturn x y = do
moveTo (x - memberWidth / 2) y'
showLayout l
- path = (if isReturn then id else Markup.b) $ Markup.escape p
+ path = (if isReturn then id else Marquee.b) $ Marquee.escape p
fullMethod =
- (if isReturn then Markup.i else id) $ Markup.formatMember i m
+ (if isReturn then Marquee.i else id) $ Marquee.formatMember i m
drawTimestamp :: String -> Double -> Double -> Render ()
drawTimestamp ts x y = do
moveTo (x - timestampWidth / 2) (y - 10)
- showLayout =<< mkLayout (Markup.escape ts) EllipsizeNone AlignLeft `withWidth` timestampWidth
+ showLayout =<< mkLayout (Marquee.escape ts) EllipsizeNone AlignLeft `withWidth` timestampWidth
drawClientLines :: NonEmpty Double -> Double -> Double -> Render ()
drawClientLines xs y1 y2 = saved $ do
diff --git a/Bustle/Markup.hs b/Bustle/Marquee.hs
similarity index 67%
rename from Bustle/Markup.hs
rename to Bustle/Marquee.hs
index 5c31552..46c2b4c 100644
--- a/Bustle/Markup.hs
+++ b/Bustle/Marquee.hs
@@ -1,6 +1,6 @@
{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
{-
-Bustle.Diagram: My First Type-Safe Markup Library
+Bustle.Marquee: My First Type-Safe Markup Library With A Cutesy Name To Not Collide With Pango's 'Markup' Which Is A Synonym For String
Copyright © 2011 Will Thompson
This library is free software; you can redistribute it and/or
@@ -17,9 +17,9 @@ You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
-}
-module Bustle.Markup
- ( Markup
- , unMarkup
+module Bustle.Marquee
+ ( Marquee
+ , toPangoMarkup
, tag
, b
, i
@@ -29,6 +29,8 @@ module Bustle.Markup
, escape
, formatMember
+
+ , toString
)
where
@@ -42,44 +44,44 @@ import Graphics.Rendering.Pango.Markup (markSpan, SpanAttribute(..))
import Bustle.Types (ObjectPath, formatObjectPath, InterfaceName, formatInterfaceName, MemberName, formatMemberName)
-newtype Markup = Markup { unMarkup :: String }
+newtype Marquee = Marquee { unMarquee :: String }
deriving (Show, Read, Ord, Eq)
-instance Monoid Markup where
- mempty = Markup ""
- mappend x y = Markup (unMarkup x `mappend` unMarkup y)
- mconcat = Markup . mconcat . map unMarkup
+toPangoMarkup :: Marquee -> String
+toPangoMarkup = unMarquee
---raw :: String -> Markup
---raw = Markup
+instance Monoid Marquee where
+ mempty = Marquee ""
+ mappend x y = Marquee (unMarquee x `mappend` unMarquee y)
+ mconcat = Marquee . mconcat . map unMarquee
-tag :: String -> Markup -> Markup
+tag :: String -> Marquee -> Marquee
tag name contents =
- Markup $ concat [ "<", name, ">"
- , unMarkup contents
+ Marquee $ concat [ "<", name, ">"
+ , unMarquee contents
, "</", name, ">"
]
-b, i :: Markup -> Markup
+b, i :: Marquee -> Marquee
b = tag "b"
i = tag "i"
a :: String
-> String
- -> Markup
+ -> Marquee
a href contents =
- Markup $ concat [ "<a href=\"", escapeMarkup href, "\">"
+ Marquee $ concat [ "<a href=\"", escapeMarkup href, "\">"
, escapeMarkup contents
, "</a>"
]
-span_ :: [SpanAttribute] -> Markup -> Markup
-span_ attrs = Markup . markSpan attrs . unMarkup
+span_ :: [SpanAttribute] -> Marquee -> Marquee
+span_ attrs = Marquee . markSpan attrs . unMarquee
-light :: Markup -> Markup
+light :: Marquee -> Marquee
light = span_ [FontWeight WeightLight]
-red :: Markup -> Markup
+red :: Marquee -> Marquee
red = span_ [FontForeground "#ff0000"]
-- Kind of a transitional measure because some strings are Strings, and some are Text.
@@ -101,12 +103,12 @@ instance Unescaped ObjectPath where
instance Unescaped MemberName where
toString = formatMemberName
-escape :: Unescaped s => s -> Markup
-escape = Markup . escapeMarkup . toString
+escape :: Unescaped s => s -> Marquee
+escape = Marquee . escapeMarkup . toString
-formatMember :: Maybe InterfaceName -> MemberName -> Markup
+formatMember :: Maybe InterfaceName -> MemberName -> Marquee
formatMember iface member = iface' `mappend` b (escape member)
where
iface' = case iface of
- Just ifaceName -> escape ifaceName `mappend` Markup "."
+ Just ifaceName -> escape ifaceName `mappend` Marquee "."
Nothing -> light (escape "(no interface) ")
diff --git a/Bustle/StatisticsPane.hs b/Bustle/StatisticsPane.hs
index 8e895a8..1faead4 100644
--- a/Bustle/StatisticsPane.hs
+++ b/Bustle/StatisticsPane.hs
@@ -26,12 +26,12 @@ where
import Control.Applicative ((<$>))
import Control.Monad (forM_)
import Text.Printf
-import Graphics.UI.Gtk hiding (Markup)
+import Graphics.UI.Gtk
import Bustle.Stats
import Bustle.Translation (__)
import Bustle.Types (Log)
-import qualified Bustle.Markup as Markup
-import Bustle.Markup (Markup)
+import qualified Bustle.Marquee as Marquee
+import Bustle.Marquee (Marquee)
import Data.Monoid
data StatsPane =
@@ -83,20 +83,20 @@ statsPaneSetMessages sp sessionMessages systemMessages = do
addTextRenderer :: TreeViewColumn
-> ListStore a
-> Bool
- -> (a -> Markup)
+ -> (a -> Marquee)
-> IO CellRendererText
addTextRenderer col store expand f = do
renderer <- cellRendererTextNew
cellLayoutPackStart col renderer expand
set renderer [ cellTextSizePoints := 7 ]
cellLayoutSetAttributes col renderer store $ \x ->
- [ cellTextMarkup := (Just . Markup.unMarkup) $ f x ]
+ [ cellTextMarkup := (Just . Marquee.toPangoMarkup) $ f x ]
return renderer
addMemberRenderer :: TreeViewColumn
-> ListStore a
-> Bool
- -> (a -> Markup)
+ -> (a -> Marquee)
-> IO CellRendererText
addMemberRenderer col store expand f = do
renderer <- addTextRenderer col store expand f
@@ -110,7 +110,7 @@ addMemberRenderer col store expand f = do
addStatColumn :: TreeView
-> ListStore a
-> String
- -> (a -> Markup)
+ -> (a -> Marquee)
-> IO ()
addStatColumn view store title f = do
col <- treeViewColumnNew
@@ -126,7 +126,7 @@ addTextStatColumn :: TreeView
-> (a -> String)
-> IO ()
addTextStatColumn view store title f =
- addStatColumn view store title (Markup.escape . f)
+ addStatColumn view store title (Marquee.escape . f)
-- If we managed to load the method and signal icons...
maybeAddTypeIconColumn :: CellLayoutClass layout
@@ -164,7 +164,7 @@ newCountView method signal = do
TallySignal -> False
addMemberRenderer nameColumn countStore True $ \fi ->
- Markup.formatMember (fiInterface fi) (fiMember fi)
+ Marquee.formatMember (fiInterface fi) (fiMember fi)
treeViewAppendColumn countView nameColumn
countColumn <- treeViewColumnNew
@@ -203,7 +203,7 @@ newTimeView = do
]
addMemberRenderer nameColumn timeStore True $ \ti ->
- Markup.formatMember (tiInterface ti) (tiMethodName ti)
+ Marquee.formatMember (tiInterface ti) (tiMethodName ti)
treeViewAppendColumn timeView nameColumn
addTextStatColumn timeView timeStore (__ "Total")
@@ -214,16 +214,16 @@ newTimeView = do
return (timeStore, timeView)
-formatSizeInfoMember :: SizeInfo -> Markup
+formatSizeInfoMember :: SizeInfo -> Marquee
formatSizeInfoMember si =
- f (Markup.formatMember (siInterface si) (siName si))
+ f (Marquee.formatMember (siInterface si) (siName si))
where
f = case siType si of
- SizeReturn -> Markup.i
- SizeError -> Markup.red
+ SizeReturn -> Marquee.i
+ SizeError -> Marquee.red
_ -> id
-formatSize :: Int -> Markup
+formatSize :: Int -> Marquee
formatSize s
| s < maxB = value 1 `mappend` units (__ "B")
| s < maxKB = value 1024 `mappend` units (__ "KB")
@@ -232,9 +232,9 @@ formatSize s
maxB = 10000
maxKB = 10000 * 1024
- units = Markup.escape . (' ':)
+ units = Marquee.escape . (' ':)
- value factor = Markup.escape (show (s `div` factor))
+ value factor = Marquee.escape (show (s `div` factor))
newSizeView :: Maybe Pixbuf
-> Maybe Pixbuf
diff --git a/Bustle/UI.hs b/Bustle/UI.hs
index a78797e..733dd08 100644
--- a/Bustle/UI.hs
+++ b/Bustle/UI.hs
@@ -38,6 +38,7 @@ import Bustle.Application.Monad
import Bustle.Renderer
import Bustle.Types
import Bustle.Diagram
+import Bustle.Marquee (toString)
import Bustle.Util
import Bustle.UI.AboutDialog
import Bustle.UI.Canvas
@@ -281,7 +282,7 @@ promptToSave wi = io $ do
case mdetails of
Just (RecordedLog tempFilePath) -> do
let tempFileName = takeFileName tempFilePath
- title = printf (__ "Save log '%s' before closing?") tempFileName
+ title = printf (__ "Save log '%s' before closing?") tempFileName :: String
prompt <- messageDialogNew (Just (wiWindow wi))
[DialogModal]
MessageWarning
@@ -459,7 +460,8 @@ wiSetLogDetails :: WindowInfo
-> IO ()
wiSetLogDetails wi logDetails = do
writeIORef (wiLogDetails wi) (Just logDetails)
- windowSetTitle (wiWindow wi) (printf (__ "%s - Bustle") (logWindowTitle logDetails))
+ windowSetTitle (wiWindow wi)
+ (printf (__ "%s - Bustle") (logWindowTitle logDetails) :: String)
setPage :: MonadIO io
=> WindowInfo
@@ -525,7 +527,7 @@ loadPixbuf :: FilePath -> IO (Maybe Pixbuf)
loadPixbuf filename = do
iconName <- getDataFileName $ "data/" ++ filename
C.catch (fmap Just (pixbufNewFromFile iconName))
- (\(GError _ _ msg) -> warn msg >> return Nothing)
+ (\(GError _ _ msg) -> warn (toString msg) >> return Nothing)
openDialogue :: Window -> B ()
openDialogue window = embedIO $ \r -> do
diff --git a/Bustle/UI/Canvas.hs b/Bustle/UI/Canvas.hs
index 46c1582..13ec44e 100644
--- a/Bustle/UI/Canvas.hs
+++ b/Bustle/UI/Canvas.hs
@@ -16,6 +16,7 @@ You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
-}
+{-# LANGUAGE OverloadedStrings #-}
module Bustle.UI.Canvas
(
Canvas
@@ -58,7 +59,7 @@ canvasNew :: Eq a
-> (Maybe a -> IO ())
-> IO (Canvas a)
canvasNew builder showBounds selectionChangedCb = do
- layout <- builderGetObject builder castToLayout "diagramLayout"
+ layout <- builderGetObject builder castToLayout ("diagramLayout" :: String)
idRef <- newIORef Nothing
shapesRef <- newIORef []
widthRef <- newIORef 0
diff --git a/Bustle/UI/DetailsView.hs b/Bustle/UI/DetailsView.hs
index 35e80d6..c347bbd 100644
--- a/Bustle/UI/DetailsView.hs
+++ b/Bustle/UI/DetailsView.hs
@@ -25,13 +25,13 @@ module Bustle.UI.DetailsView
where
import Data.List (intercalate)
-import Graphics.UI.Gtk hiding (Signal, Markup)
+import Graphics.UI.Gtk hiding (Signal)
import qualified DBus as D
import Bustle.Translation (__)
import Bustle.Types
-import Bustle.Markup
+import Bustle.Marquee
import Bustle.VariantFormatter
data DetailsView =
@@ -55,7 +55,7 @@ addValue :: Table
-> Int
-> IO Label
addValue table row = do
- label <- labelNew Nothing
+ label <- labelNew (Nothing :: Maybe String)
miscSetAlignment label 0 0
labelSetEllipsize label EllipsizeStart
labelSetSelectable label True
@@ -77,7 +77,7 @@ detailsViewNew = do
, tableColumnSpacing := 6
]
- title <- labelNew Nothing
+ title <- labelNew (Nothing :: Maybe String)
miscSetAlignment title 0 0
tableAttach table title 0 2 0 1 [Fill] [Fill] 0 0
@@ -99,7 +99,7 @@ detailsViewNew = do
widgetShowAll table
return $ DetailsView table title pathLabel memberLabel view
-pickTitle :: Detailed Message -> Markup
+pickTitle :: Detailed Message -> Marquee
pickTitle (Detailed _ m _) = case m of
MethodCall {} -> b (escape (__ "Method call"))
MethodReturn {} -> b (escape (__ "Method return"))
@@ -111,7 +111,7 @@ pickTitle (Detailed _ m _) = case m of
getMemberMarkup :: Member -> String
getMemberMarkup m =
- unMarkup $ formatMember (iface m) (membername m)
+ toPangoMarkup $ formatMember (iface m) (membername m)
getMember :: Detailed Message -> Maybe Member
getMember (Detailed _ m _) = case m of
@@ -140,7 +140,7 @@ detailsViewUpdate :: DetailsView
detailsViewUpdate d m = do
buf <- textViewGetBuffer $ detailsBodyView d
let member_ = getMember m
- labelSetMarkup (detailsTitle d) (unMarkup $ pickTitle m)
+ labelSetMarkup (detailsTitle d) (toPangoMarkup $ pickTitle m)
labelSetText (detailsPath d) (maybe unknown (D.formatObjectPath . path) member_)
labelSetMarkup (detailsMember d) (maybe unknown getMemberMarkup member_)
textBufferSetText buf $ formatMessage m
diff --git a/Bustle/UI/FilterDialog.hs b/Bustle/UI/FilterDialog.hs
index 9560507..152931e 100644
--- a/Bustle/UI/FilterDialog.hs
+++ b/Bustle/UI/FilterDialog.hs
@@ -99,7 +99,7 @@ runFilterDialog parent names currentlyHidden = do
nameStore <- makeStore names currentlyHidden
sw <- makeView nameStore
- instructions <- labelNew Nothing
+ instructions <- labelNew (Nothing :: Maybe String)
widgetSetSizeRequest instructions 600 (-1)
labelSetMarkup instructions
(__ "Unticking a service hides its column in the diagram, \
diff --git a/Bustle/UI/Recorder.hs b/Bustle/UI/Recorder.hs
index 1e98a68..d0546bd 100644
--- a/Bustle/UI/Recorder.hs
+++ b/Bustle/UI/Recorder.hs
@@ -36,6 +36,7 @@ import Graphics.UI.Gtk
import Bustle.Loader.Pcap (convert)
import Bustle.Loader (isRelevant)
+import Bustle.Marquee (toString)
import Bustle.Monitor
import Bustle.Renderer
import Bustle.Translation (__)
@@ -78,7 +79,7 @@ processBatch pendingRef n label incoming = do
i <- takeMVar n
let j = i + (length pending)
labelSetMarkup label $
- printf (__ "Logged <b>%u</b> messages…") j
+ (printf (__ "Logged <b>%u</b> messages…") j :: String)
putMVar n j
incoming rr'
@@ -97,8 +98,9 @@ recorderRun filename mwindow incoming finished = C.handle newFailed $ do
maybe (return ()) (windowSetTransientFor dialog) mwindow
dialog `set` [ windowModal := True ]
- label <- labelNew Nothing
- labelSetMarkup label $ printf (__ "Logged <b>%u</b> messages…") (0 :: Int)
+ label <- labelNew (Nothing :: Maybe String)
+ labelSetMarkup label $
+ (printf (__ "Logged <b>%u</b> messages…") (0 :: Int) :: String)
loaderStateRef <- newMVar Map.empty
pendingRef <- newMVar []
let updateLabel µs body = do
@@ -142,7 +144,7 @@ recorderRun filename mwindow incoming finished = C.handle newFailed $ do
widgetShowAll dialog
where
newFailed (GError _ _ message) = do
- displayError mwindow message Nothing
+ displayError mwindow (toString message) Nothing
recorderChooseFile :: FilePath
-> Maybe Window
diff --git a/HACKING b/HACKING.md
similarity index 100%
rename from HACKING
rename to HACKING.md
diff --git a/INSTALL b/INSTALL.md
similarity index 100%
rename from INSTALL
rename to INSTALL.md
diff --git a/Makefile b/Makefile
index 0b228ed..918aa3c 100644
--- a/Makefile
+++ b/Makefile
@@ -18,6 +18,7 @@ APPDATA_FILE = bustle.appdata.xml
ICON_SIZES = 16x16 22x22 32x32 48x48 256x256
ICONS = \
data/icons/scalable/bustle.svg \
+ data/icons/scalable/bustle-symbolic.svg \
$(foreach size,$(ICON_SIZES),data/icons/$(size)/bustle.png) \
$(NULL)
@@ -58,6 +59,8 @@ install: all
cp $(APPDATA_FILE) $(DATADIR)/appdata
$(foreach size,$(ICON_SIZES),mkdir -p $(DATADIR)/icons/hicolor/$(size)/apps; )
$(foreach size,$(ICON_SIZES),cp data/icons/$(size)/bustle.png $(DATADIR)/icons/hicolor/$(size)/apps; )
+ mkdir -p $(DATADIR)/icons/hicolor/scalable/apps
+ cp data/icons/scalable/bustle-symbolic.svg $(DATADIR)/icons/hicolor/scalable/apps
$(MAKE) update-icon-cache
uninstall:
@@ -66,6 +69,7 @@ uninstall:
rm -f $(DATADIR)/applications/$(DESKTOP_FILE)
rm -f $(DATADIR)/appdata/$(APPDATA_FILE)
$(foreach size,$(ICON_SIZES),rm -f $(DATADIR)/icons/hicolor/$(size)/apps/bustle.png)
+ rm -f $(DATADIR)/icons/hicolor/scalable/apps/bustle-symbolic.svg
$(MAKE) update-icon-cache
clean:
@@ -95,10 +99,10 @@ maintainer-binary-tarball: all
mkdir -p $(TARBALL_FULL_DIR)
cabal-dev install --prefix=$(TOP)/$(TARBALL_FULL_DIR) \
--datadir=$(TOP)/$(TARBALL_FULL_DIR) --datasubdir=.
- cp bustle.sh README $(TARBALL_FULL_DIR)
+ cp bustle.sh README.md $(TARBALL_FULL_DIR)
perl -pi -e 's{^ bustle-pcap}{ ./bustle-pcap};' \
-e 's{^ bustle} { ./bustle.sh};' \
- $(TARBALL_FULL_DIR)/README
+ $(TARBALL_FULL_DIR)/README.md
cp $(BINARIES) $(MANPAGE) $(DESKTOP_FILE) $(APPDATA_FILE) $(TARBALL_FULL_DIR)
mkdir -p $(TARBALL_FULL_DIR)/lib
cp LICENSE.bundled-libraries $(TARBALL_FULL_DIR)/lib
@@ -108,3 +112,10 @@ maintainer-binary-tarball: all
maintainer-update-messages-pot:
find Bustle -name '*.hs' -print0 | xargs -0 hgettext -k __ -o po/messages.pot
+
+maintainer-make-release: bustle.cabal
+ 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`
+ make maintainer-binary-tarball
diff --git a/NEWS b/NEWS.md
similarity index 96%
rename from NEWS
rename to NEWS.md
index 5a38571..b1b417e 100644
--- a/NEWS
+++ b/NEWS.md
@@ -1,3 +1,14 @@
+Bustle 0.4.8 (2015-03-22)
+-------------------------
+
+* Be compatible with recent versions of Gtk2HS which use Text rather
+ than Strings in many places. Should still build against older
+ releases. Let me know if not.
+* [#89712][]: Add symbolic icon. (Arnaud Bonatti)
+
+[#89712]: https://bugs.freedesktop.org/show_bug.cgi?id=89712
+
+
Bustle 0.4.7 (2014-07-19)
-------------------------
diff --git a/README b/README.md
similarity index 100%
rename from README
rename to README.md
diff --git a/Test/Regions.hs b/Test/Regions.hs
index c9aca2c..a6c6076 100644
--- a/Test/Regions.hs
+++ b/Test/Regions.hs
@@ -4,23 +4,27 @@ import Test.QuickCheck.All
import Data.List (sort, group)
import Data.Maybe (isNothing, isJust)
+import Control.Applicative ((<$>), (<*>))
import Bustle.Regions
-instance Arbitrary Stripe where
- arbitrary = do
- top <- fmap abs arbitrary
- bottom <- arbitrary `suchThat` (>= top)
- return $ Stripe top bottom
-
newtype NonOverlappingStripes = NonOverlappingStripes [Stripe]
deriving
(Show, Eq, Ord)
instance Arbitrary NonOverlappingStripes where
arbitrary = do
- -- there is no orderedList1 sadly
- stripes <- fmap sort (listOf1 arbitrary) `suchThat` nonOverlapping
+ -- listOf2
+ tops <- sort <$> ((:) <$> arbitrary <*> (listOf1 arbitrary))
+
+ -- Generate dense stripes sometimes
+ let g :: Gen Double
+ g = frequency [(1, return 1.0), (7, choose (0.0, 1.0))]
+
+ rs <- vectorOf (length tops) (choose (0.0, 1.0))
+
+ let stripes = zipWith3 (\t1 t2 r -> Stripe t1 (t1 + ((t2 - t1) * r)))
+ tops (tail tops) rs
return $ NonOverlappingStripes stripes
newtype ValidRegions a = ValidRegions (Regions a)
@@ -40,6 +44,8 @@ instance (Eq a, Arbitrary a) => Arbitrary (RegionSelection a) where
ValidRegions rs <- arbitrary
return $ regionSelectionNew rs
+prop_NonOverlapping_generator_works (NonOverlappingStripes ss) = nonOverlapping ss
+
prop_InitiallyUnselected = \rs -> isNothing $ rsCurrent rs
prop_UpDoesNothing = \rs -> isNothing $ rsCurrent $ regionSelectionUp rs
diff --git a/bustle.cabal b/bustle.cabal
index 4ac107c..249bc99 100644
--- a/bustle.cabal
+++ b/bustle.cabal
@@ -1,9 +1,9 @@
Name: bustle
Category: Network, Desktop
-Version: 0.4.7
+Version: 0.4.8
Cabal-Version: >= 1.8
-Synopsis: Draw pretty sequence diagrams of D-Bus traffic
-Description: Draw pretty sequence diagrams of D-Bus traffic
+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>
@@ -21,10 +21,10 @@ Extra-source-files:
Makefile,
-- Stuff for nerds
- README,
- NEWS,
- HACKING,
- INSTALL,
+ README.md,
+ NEWS.md,
+ HACKING.md,
+ INSTALL.md,
run-uninstalled.sh
, Test/data/log-with-h.bustle
@@ -48,6 +48,7 @@ Extra-source-files:
, data/icons/48x48/bustle.png
, data/icons/256x256/bustle.png
, data/icons/scalable/bustle.svg
+ , data/icons/scalable/bustle-symbolic.svg
x-gettext-po-files: po/*.po
x-gettext-domain-name: bustle
@@ -71,7 +72,7 @@ Executable bustle
, Bustle.Loader
, Bustle.Loader.OldSkool
, Bustle.Loader.Pcap
- , Bustle.Markup
+ , Bustle.Marquee
, Bustle.Monitor
, Bustle.Noninteractive
, Bustle.Regions
diff --git a/data/icons/scalable/bustle-symbolic.svg b/data/icons/scalable/bustle-symbolic.svg
new file mode 100644
index 0000000..b04e7c1
--- /dev/null
+++ b/data/icons/scalable/bustle-symbolic.svg
@@ -0,0 +1,104 @@
+<?xml version="1.0" encoding="UTF-8" standalone="no"?>
+<!-- Created with Inkscape (http://www.inkscape.org/) -->
+
+<svg
+ xmlns:dc="http://purl.org/dc/elements/1.1/"
+ xmlns:cc="http://creativecommons.org/ns#"
+ xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
+ xmlns:svg="http://www.w3.org/2000/svg"
+ xmlns="http://www.w3.org/2000/svg"
+ xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd"
+ xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape"
+ width="600"
+ height="600"
+ id="svg2"
+ version="1.1"
+ inkscape:version="0.91 r13725"
+ sodipodi:docname="bustle-symbolic.svg">
+ <defs
+ id="defs4" />
+ <sodipodi:namedview
+ id="base"
+ pagecolor="#ffffff"
+ bordercolor="#666666"
+ borderopacity="1.0"
+ inkscape:pageopacity="0.0"
+ inkscape:pageshadow="2"
+ inkscape:zoom="1.18"
+ inkscape:cx="296.02826"
+ inkscape:cy="407.83651"
+ inkscape:document-units="px"
+ inkscape:current-layer="layer1"
+ showgrid="false"
+ inkscape:window-width="1440"
+ inkscape:window-height="824"
+ inkscape:window-x="0"
+ inkscape:window-y="27"
+ inkscape:window-maximized="1"
+ fit-margin-top="0"
+ fit-margin-left="0"
+ fit-margin-right="0"
+ fit-margin-bottom="0"
+ showguides="true"
+ inkscape:guide-bbox="true">
+ <inkscape:grid
+ type="xygrid"
+ id="grid3834"
+ empspacing="5"
+ visible="true"
+ enabled="true"
+ snapvisiblegridlinesonly="true"
+ originx="-56.941089px"
+ originy="-465.18127px" />
+ </sodipodi:namedview>
+ <metadata
+ id="metadata7">
+ <rdf:RDF>
+ <cc:Work
+ rdf:about="">
+ <dc:format>image/svg+xml</dc:format>
+ <dc:type
+ rdf:resource="http://purl.org/dc/dcmitype/StillImage" />
+ <dc:title></dc:title>
+ </cc:Work>
+ </rdf:RDF>
+ </metadata>
+ <g
+ inkscape:label="Layer 1"
+ inkscape:groupmode="layer"
+ id="layer1"
+ transform="translate(-56.941089,12.819102)">
+ <path
+ style="color:#000000;font-style:normal;font-variant:normal;font-weight:normal;font-stretch:normal;font-size:medium;line-height:normal;font-family:sans-serif;text-indent:0;text-align:start;text-decoration:none;text-decoration-line:none;text-decoration-style:solid;text-decoration-color:#000000;letter-spacing:normal;word-spacing:normal;text-transform:none;direction:ltr;block-progression:tb;writing-mode:lr-tb;baseline-shift:baseline;text-anchor:start;white-space:normal;clip-rule:nonze [...]
+ d="m 349.58008,-12.728516 c -19.78034,0.499891 -39.51808,2.890348 -58.82031,7.2539096 4.10872,18.8723954 8.21745,37.7447914 12.32617,56.6171874 33.74925,-7.665785 69.12626,-7.971229 103.02539,-1.0293 3.71633,-18.821141 8.65912,-38.435398 11.61328,-56.7636714 -22.39128,-4.5980686 -45.29405,-6.6135646 -68.14453,-6.0781256 z m 105.80078,78.716797 c 31.47813,14.008295 59.87299,34.867319 82.70703,60.664059 14.44727,-12.81901 28.89453,-25.63802 43.3418,-38.457028 C 553.05494,56.141376 5 [...]
+ id="path4626"
+ inkscape:connector-curvature="0" />
+ <circle
+ style="fill:none;stroke:#bebebe;stroke-width:75.08624021;stroke-miterlimit:5.19999981;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1"
+ id="path2985-7"
+ cx="381.42856"
+ cy="433.79074"
+ transform="matrix(0.50880116,0,0,0.55776489,164.13818,45.848517)"
+ ry="118.57143"
+ rx="130" />
+ <path
+ style="color:#000000;font-style:normal;font-variant:normal;font-weight:normal;font-stretch:normal;font-size:medium;line-height:normal;font-family:sans-serif;text-indent:0;text-align:start;text-decoration:none;text-decoration-line:none;text-decoration-style:solid;text-decoration-color:#000000;letter-spacing:normal;word-spacing:normal;text-transform:none;direction:ltr;block-progression:tb;writing-mode:lr-tb;baseline-shift:baseline;text-anchor:start;white-space:normal;clip-rule:nonze [...]
+ d="m 430,220 30,55 -85,0 0,50 85,0 -30,55 170,-80 z"
+ transform="translate(56.941089,-12.819102)"
+ id="path3757-7"
+ inkscape:connector-curvature="0"
+ sodipodi:nodetypes="cccccccc" />
+ <path
+ style="color:#000000;font-style:normal;font-variant:normal;font-weight:normal;font-stretch:normal;font-size:medium;line-height:normal;font-family:sans-serif;text-indent:0;text-align:start;text-decoration:none;text-decoration-line:none;text-decoration-style:solid;text-decoration-color:#000000;letter-spacing:normal;word-spacing:normal;text-transform:none;direction:ltr;block-progression:tb;writing-mode:lr-tb;baseline-shift:baseline;text-anchor:start;white-space:normal;clip-rule:nonze [...]
+ d="m 170,220 -170,80 170,80 -30,-55 85,0 0,-50 -85,0 z"
+ transform="translate(56.941089,-12.819102)"
+ id="path3761-7"
+ inkscape:connector-curvature="0"
+ sodipodi:nodetypes="cccccccc" />
+ <path
+ style="color:#000000;font-style:normal;font-variant:normal;font-weight:normal;font-stretch:normal;font-size:medium;line-height:normal;font-family:sans-serif;text-indent:0;text-align:start;text-decoration:none;text-decoration-line:none;text-decoration-style:solid;text-decoration-color:#000000;letter-spacing:normal;word-spacing:normal;text-transform:none;direction:ltr;block-progression:tb;writing-mode:lr-tb;baseline-shift:baseline;text-anchor:start;white-space:normal;clip-rule:nonze [...]
+ d="m 356.94141,187.18164 c -55.02475,0 -100.00001,44.97526 -100,100 -1e-5,55.02475 44.97525,100 100,100 55.02475,0 100,-44.97525 100,-100 0,-55.02475 -44.97525,-100 -100,-100 z m 0,34.39844 c 36.43357,0 65.59961,29.168 65.59961,65.60156 0,36.43356 -29.16604,65.59961 -65.59961,65.59961 -36.43357,0 -65.59961,-29.16605 -65.59961,-65.59961 0,-36.43356 29.16604,-65.60156 65.59961,-65.60156 z"
+ id="path4619"
+ inkscape:connector-curvature="0" />
+ </g>
+</svg>
diff --git a/data/icons/scalable/bustle.svg b/data/icons/scalable/bustle.svg
index 66af4b1..a2c9a8d 100644
--- a/data/icons/scalable/bustle.svg
+++ b/data/icons/scalable/bustle.svg
@@ -203,10 +203,7 @@
style="fill:none;stroke:#74b674;stroke-width:27.59247017;stroke-miterlimit:4;stroke-opacity:1;stroke-dasharray:82.77741051, 27.59247017;stroke-dashoffset:27.59247017"
d="m 70.761814,288.36996 c -0.01207,-1.2669 -0.02449,-2.53589 -0.02449,-3.80671 0,-159.41492 129.271656,-288.6461129 288.736206,-288.6461129 159.46457,0 288.73621,129.2311929 288.73621,288.6461129 l 0,0 0,0 c 0,1.27082 -0.009,2.53969 -0.0245,3.80671"
id="path3802-8"
- inkscape:connector-curvature="0"
- inkscape:export-filename="/home/ziz-2/Desktop/kkkkkkkk.png"
- inkscape:export-xdpi="8.2586517"
- inkscape:export-ydpi="8.2586517" />
+ inkscape:connector-curvature="0" />
<path
sodipodi:type="arc"
style="fill:none;stroke:#000000;stroke-width:34.42315674;stroke-miterlimit:10;stroke-opacity:1;stroke-dasharray:none;stroke-dashoffset:0"
@@ -217,9 +214,7 @@
sodipodi:ry="118.57143"
d="m 511.42856,433.79074 a 130,118.57143 0 1 1 -260,0 130,118.57143 0 1 1 260,0 z"
transform="matrix(0.50880116,0,0,0.55776489,164.13818,45.848517)"
- inkscape:export-filename="/home/ziz-2/Desktop/kkkkkkkk.png"
- inkscape:export-xdpi="8.2586517"
- inkscape:export-ydpi="8.2586517" />
+ />
<path
style="fill:none;stroke:#000000;stroke-width:18.45480156;stroke-linecap:butt;stroke-linejoin:miter;stroke-miterlimit:4;stroke-opacity:1;stroke-dasharray:none"
d="m 417.41556,287.80173 211.44171,0"
@@ -227,9 +222,7 @@
inkscape:path-effect="#path-effect3759-7"
inkscape:original-d="m 417.41556,287.80173 211.44171,0"
inkscape:connector-curvature="0"
- inkscape:export-filename="/home/ziz-2/Desktop/kkkkkkkk.png"
- inkscape:export-xdpi="8.2586517"
- inkscape:export-ydpi="8.2586517" />
+ />
<path
style="fill:none;stroke:#000000;stroke-width:18.17925262;stroke-linecap:butt;stroke-linejoin:miter;stroke-miterlimit:4;stroke-opacity:1;stroke-dasharray:none"
d="m 294.08479,287.66116 -211.718251,0.2812"
@@ -237,9 +230,7 @@
inkscape:path-effect="#path-effect3763-2"
inkscape:original-d="m 294.08479,287.66116 -211.718251,0.2812"
inkscape:connector-curvature="0"
- inkscape:export-filename="/home/ziz-2/Desktop/kkkkkkkk.png"
- inkscape:export-xdpi="8.2586517"
- inkscape:export-ydpi="8.2586517" />
+ />
<path
style="fill:none;stroke:#000000;stroke-width:18.33793068;stroke-linecap:butt;stroke-linejoin:miter;stroke-miterlimit:4;stroke-opacity:1;stroke-dasharray:none"
d="M 200.97285,226.67532 77.897224,289.6408 200.97285,348.92819"
@@ -248,9 +239,7 @@
inkscape:original-d="M 200.97285,226.67532 77.897224,289.6408 200.97285,348.92819"
inkscape:connector-curvature="0"
sodipodi:nodetypes="ccc"
- inkscape:export-filename="/home/ziz-2/Desktop/kkkkkkkk.png"
- inkscape:export-xdpi="8.2586517"
- inkscape:export-ydpi="8.2586517" />
+ />
<path
style="fill:none;stroke:#000000;stroke-width:18.33793068;stroke-linecap:butt;stroke-linejoin:miter;stroke-miterlimit:4;stroke-opacity:1;stroke-dasharray:none"
d="M 520.66838,225.39683 643.74401,288.36232 520.66838,347.6497"
@@ -259,8 +248,6 @@
inkscape:original-d="M 520.66838,225.39683 643.74401,288.36232 520.66838,347.6497"
inkscape:connector-curvature="0"
sodipodi:nodetypes="ccc"
- inkscape:export-filename="/home/ziz-2/Desktop/kkkkkkkk.png"
- inkscape:export-xdpi="8.2586517"
- inkscape:export-ydpi="8.2586517" />
+ />
</g>
</svg>
--
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