Commit d784145f authored by Will Thompson's avatar Will Thompson

Modernize filter dialog

Unfortunately, setting border-width=0 on the GtkDialog's internal vbox
child is deleted by a round-trip though Glade, so one needs to be
careful with that!
parent c8b8b86c
......@@ -3,6 +3,7 @@
{-
Bustle.UI.FilterDialog: allows the user to filter the displayed log
Copyright © 2011 Collabora Ltd.
Copyright © 2019 Will Thompson
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
......@@ -30,21 +31,29 @@ import qualified Data.Function as F
import Graphics.UI.Gtk
import Bustle.Translation (__)
import Bustle.Types
import Paths_bustle
data NameEntry = NameEntry { neUniqueName :: UniqueName
, neOtherNames :: Set OtherName
, neVisible :: Bool
}
namespace :: String
-> (String, String)
namespace name = case reverse (elemIndices '.' name) of
[] -> ("", name)
(i:_) -> splitAt (i + 1) name
formatNames :: (UniqueName, Set OtherName)
formatNames :: NameEntry
-> String
formatNames (u, os)
| Set.null os = unUniqueName u
formatNames ne
| Set.null os = unUniqueName (neUniqueName ne)
| otherwise = intercalate "\n" . map (formatGroup . groupGroup) $ groups
where
os = neOtherNames ne
groups = groupBy ((==) `F.on` fst) . map (namespace . unOtherName) $ Set.toAscList os
groupGroup [] = error "unpossible empty group from groupBy"
......@@ -53,52 +62,45 @@ formatNames (u, os)
formatGroup (ns, [y]) = ns ++ y
formatGroup (ns, ys) = ns ++ "{" ++ intercalate "," ys ++ "}"
type NameStore = ListStore (Bool, (UniqueName, Set OtherName))
type NameStore = ListStore NameEntry
makeStore :: [(UniqueName, Set OtherName)]
-> Set UniqueName
-> IO NameStore
makeStore names currentlyHidden =
listStoreNew $ map toPair names
listStoreNew $ map toNameEntry names
where
toPair name@(u, _) = (not (Set.member u currentlyHidden), name)
toNameEntry (u, os) = NameEntry { neUniqueName = u
, neOtherNames = os
, neVisible = not (Set.member u currentlyHidden)
}
makeView :: NameStore
-> IO ScrolledWindow
makeView nameStore = do
nameView <- treeViewNewWithModel nameStore
-- We want rules because otherwise it's tough to see where each group
-- starts and ends
treeViewSetRulesHint nameView True
treeViewSetHeadersVisible nameView False
widgetSetSizeRequest nameView 600 371
-> TreeView
-> IO ()
makeView nameStore nameView = do
treeViewSetModel nameView (Just nameStore)
tickyCell <- cellRendererToggleNew
tickyColumn <- treeViewColumnNew
treeViewColumnPackStart tickyColumn tickyCell True
treeViewAppendColumn nameView tickyColumn
cellLayoutSetAttributes tickyColumn tickyCell nameStore $ \(ticked, _) ->
[ cellToggleActive := ticked ]
cellLayoutSetAttributes tickyColumn tickyCell nameStore $ \ne ->
[ cellToggleActive := neVisible ne ]
on tickyCell cellToggled $ \pathstr -> do
let [i] = stringToTreePath pathstr
(v, ns) <- listStoreGetValue nameStore i
listStoreSetValue nameStore i (not v, ns)
ne <- listStoreGetValue nameStore i
listStoreSetValue nameStore i (ne { neVisible = not (neVisible ne) })
nameCell <- cellRendererTextNew
nameColumn <- treeViewColumnNew
treeViewColumnPackStart nameColumn nameCell True
treeViewAppendColumn nameView nameColumn
cellLayoutSetAttributes nameColumn nameCell nameStore $ \(_, ns) ->
[ cellText := formatNames ns ]
sw <- scrolledWindowNew Nothing Nothing
scrolledWindowSetPolicy sw PolicyAutomatic PolicyAutomatic
containerAdd sw nameView
return sw
cellLayoutSetAttributes nameColumn nameCell nameStore $ \ne ->
[ cellText := formatNames ne ]
runFilterDialog :: WindowClass parent
=> parent -- ^ The window to which to attach the dialog
......@@ -106,36 +108,23 @@ runFilterDialog :: WindowClass parent
-> Set UniqueName -- ^ Currently-hidden names
-> IO (Set UniqueName) -- ^ The set of names to *hide*
runFilterDialog parent names currentlyHidden = do
d <- dialogNew
builder <- builderNew
builderAddFromFile builder =<< getDataFileName "data/FilterDialog.ui"
d <- builderGetObject builder castToDialog ("filterDialog" :: String)
(windowWidth, windowHeight) <- windowGetSize parent
windowSetDefaultSize d (windowWidth * 7 `div` 8) (windowHeight `div` 2)
d `set` [ windowTransientFor := parent ]
dialogAddButton d stockClose ResponseClose
vbox <- castToBox <$> dialogGetContentArea d
boxSetSpacing vbox 6
nameStore <- makeStore names currentlyHidden
sw <- makeView nameStore
instructions <- labelNew (Nothing :: Maybe String)
widgetSetSizeRequest instructions 600 (-1)
labelSetMarkup instructions
(__ "Unticking a service hides its column in the diagram, \
\and all messages it is involved in. That is, all methods it calls \
\or are called on it, the corresponding returns, and all signals it \
\emits will be hidden.")
labelSetLineWrap instructions True
boxPackStart vbox instructions PackNatural 0
boxPackStart vbox sw PackGrow 0
widgetShowAll vbox
makeView nameStore =<< builderGetObject builder castToTreeView ("filterTreeView" :: String)
_ <- dialogRun d
widgetDestroy d
results <- listStoreToList nameStore
return $ Set.fromList [ u
| (ticked, (u, _)) <- results
, not ticked
return $ Set.fromList [ neUniqueName ne
| ne <- results
, not (neVisible ne)
]
......@@ -11,6 +11,7 @@ Author: Will Thompson <will@willthompson.co.uk>
Maintainer: Will Thompson <will@willthompson.co.uk>
Homepage: https://gitlab.freedesktop.org/bustle/bustle#readme
Data-files: data/bustle.ui,
data/FilterDialog.ui,
data/OpenTwoDialog.ui,
data/RecordAddressDialog.ui,
LICENSE
......
<?xml version="1.0" encoding="UTF-8"?>
<!-- Generated with glade 3.22.1 -->
<interface>
<requires lib="gtk+" version="3.20"/>
<object class="GtkDialog" id="filterDialog">
<property name="can_focus">False</property>
<property name="type_hint">dialog</property>
<child type="titlebar">
<object class="GtkHeaderBar">
<property name="visible">True</property>
<property name="can_focus">False</property>
<property name="title" translatable="yes">Filter Visible Services</property>
<property name="has_subtitle">False</property>
<property name="show_close_button">True</property>
<child>
<placeholder/>
</child>
</object>
</child>
<child internal-child="vbox">
<object class="GtkBox">
<property name="can_focus">False</property>
<property name="orientation">vertical</property>
<!-- FIXME: round-tripping through Glade removes this property. -->
<property name="border_width">0</property>
<child internal-child="action_area">
<object class="GtkButtonBox">
<property name="can_focus">False</property>
<property name="layout_style">end</property>
<child>
<placeholder/>
</child>
<child>
<placeholder/>
</child>
</object>
<packing>
<property name="expand">False</property>
<property name="fill">False</property>
<property name="position">0</property>
</packing>
</child>
<child>
<object class="GtkScrolledWindow">
<property name="visible">True</property>
<property name="can_focus">True</property>
<property name="border_width">0</property>
<property name="vscrollbar_policy">always</property>
<property name="shadow_type">in</property>
<child>
<object class="GtkTreeView" id="filterTreeView">
<property name="width_request">600</property>
<property name="height_request">371</property>
<property name="visible">True</property>
<property name="can_focus">True</property>
<property name="headers_visible">False</property>
<property name="rules_hint">True</property>
<child internal-child="selection">
<object class="GtkTreeSelection"/>
</child>
</object>
</child>
</object>
<packing>
<property name="expand">True</property>
<property name="fill">True</property>
<property name="position">1</property>
</packing>
</child>
</object>
</child>
</object>
</interface>
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment