[taffybar] Use gtk-strut and pager rewrite taffybar

dotfiles/config/taffybar/imalison-taffybar.cabal

@@ -18,10 +18,12 @@ executable imalison-taffybar
                      , containers
                      , directory
                      , filepath
+                     , gtk-strut
                      , gi-gtk
                      , glib
                      , gtk3>=0.14.8
                      , gtk-sni-tray
+                     , hslogger
                      , mtl
                      , haskell-gi-base
                      , process

dotfiles/config/taffybar/stack.yaml

@@ -8,16 +8,10 @@ packages:
     git: git@github.com:willdonnelly/dyre.git
     commit: 11412752b483135e0c151ab90be17b217f837c4b
   extra-dep: true
-- location:
-    git: git@github.com:IvanMalison/gtk-traymanager.git
-    commit: 517b24722b2cdab2dadbafa882ffcb6b8a1d01ff
-  extra-dep: true
 - location: ../xmonad/xmonad-contrib
   extra-dep: true
 - location: ../../../../Projects/status-notifier-item
   extra-dep: true
-- location: ../../../../Projects/haskell-dbus
-  extra-dep: true
 - location: ../../../../Projects/gtk-sni-tray
   extra-dep: true
 - location:
@@ -27,19 +21,24 @@ packages:
       - gtk
   extra-dep: true
 extra-deps:
-- spool-0.1
 - X11-xft-0.3.1
-- gio-0.13.4.1
+- dbus-1.0.0
-- libxml-sax-0.7.5
-- rate-limit-1.1.1
-- time-units-1.0.0
-- xml-helpers-1.0.0
-- gi-dbusmenugtk3-0.4.1
 - gi-dbusmenu-0.4.1
+- gi-dbusmenugtk3-0.4.1
 - gi-gdk-3.0.15
 - gi-gdkpixbuf-2.0.15
-- gi-gtk-3.0.21
+- gi-gdkx11-3.0.2
 - gi-gio-2.0.16
+- gi-gtk-3.0.21
 - gi-pango-1.0.16
-resolver: lts-10.5
+- gi-xlib-2.0.2
+- gio-0.13.4.1
+- gtk-strut-0.1.2.0
+- gtk-traymanager-1.0.1
+- libxml-sax-0.7.5
+- rate-limit-1.1.1
+- spool-0.1
+- time-units-1.0.0
+- xml-helpers-1.0.0
+resolver: lts-11.4
 allow-newer: true

dotfiles/config/taffybar/taffybar

@@ -1 +1 @@
-Subproject commit 95271053be679da8453317396cb3ce5d74e44604
+Subproject commit 1c2dbadc40ce23a54a465bc072b1fce208c9be7e

dotfiles/config/taffybar/taffybar.hs

@@ -11,6 +11,7 @@ import                  Data.List
 import                  Data.List.Split
 import qualified        Data.Map as M
 import                  Data.Maybe
+import                  Debug.Trace
 import                  Foreign.ForeignPtr
 import                  Foreign.Ptr
 import qualified        GI.Gtk as GI
@@ -23,10 +24,13 @@ import                  System.Directory
 import                  System.Environment
 import                  System.FilePath.Posix
 import                  System.Glib.GObject
+import                  System.IO
 import                  System.Information.CPU
 import                  System.Information.EWMHDesktopInfo
 import                  System.Information.Memory
 import                  System.Information.X11DesktopInfo
+import                  System.Log.Handler.Simple
+import                  System.Log.Logger
 import                  System.Process
 import                  System.Taffybar
 import                  System.Taffybar.Battery
@@ -34,8 +38,8 @@ import                  System.Taffybar.IconImages
 import                  System.Taffybar.LayoutSwitcher
 import                  System.Taffybar.MPRIS2
 import                  System.Taffybar.NetMonitor
-import                  System.Taffybar.Pager
 import                  System.Taffybar.SimpleClock
+import                  System.Taffybar.SimpleConfig
 import                  System.Taffybar.Systray
 import                  System.Taffybar.ToggleMonitor
 import                  System.Taffybar.Widgets.PollingGraph
@@ -134,18 +138,28 @@ getInterfaces = do
 
 addClass klass action = do
   widget <- action
-  widgetSetClass widget klass
+  lift $ widgetSetClass widget klass
   return widget
 
 (buildWidgetCons, _) = mkWidget
 
 buildSNITray = do
+  -- XXX: this won't work for multiple taffybars because it will attempt to
+  -- register a second host with a name that already exists on the dbus tray.
+  -- Need to take an approach similar to that of gtk-sni-tray to get that to
+  -- work.
   GI.Widget trayGIWidgetMP <- buildTrayWithHost GI.OrientationHorizontal
   wrapNewGObject mkWidget (castPtr <$> disownManagedPtr trayGIWidgetMP)
 
+logDebug = do
+  handler <- streamHandler stdout DEBUG
+  logger <- getLogger "System.Taffybar"
+  saveGlobalLogger $ setLevel DEBUG logger
+
 main = do
   interfaceNames <- getInterfaces
   homeDirectory <- getHomeDirectory
+  logDebug
   let resourcesDirectory = homeDirectory </> ".lib" </> "resources"
       inResourcesDirectory file = resourcesDirectory </> file
       highContrastDirectory =
@@ -209,24 +223,21 @@ main = do
         --       ]
         , showWorkspaceFn = hideEmpty
         , updateRateLimitMicroseconds = 100000
-        , updateOnWMIconChange = True
         , debugMode = False
         , labelSetter = workspaceNamesLabelSetter
         }
       netMonitor = netMonitorMultiNew 1.5 interfaceNames
-      pagerConfig =
-        defaultPagerConfig
-        {useImages = True, windowSwitcherFormatter = myFormatEntry}
       -- makeUnderline = underlineWidget myHUDConfig
-  pgr <- pagerNew pagerConfig
+  -- pgr <- pagerNew pagerConfig
   -- tray2 <- movableWidget tray
-  let hud = buildWorkspaceHUD myHUDConfig pgr
+  let hud = buildWorkspaceHUD myHUDConfig
-      los = layoutSwitcherNew pgr
+      los = layoutSwitcherNew defaultLayoutSwitcherConfig
-      wnd = windowSwitcherNew pgr
+      wnd = windowSwitcherNew defaultWindowSwitcherConfig
-      taffyConfig =
+      simpleTaffyConfig =
-        defaultTaffybarConfig
+        defaultSimpleTaffyConfig
         { startWidgets = [hud, los, addClass "WindowSwitcher" wnd]
-        , endWidgets =
+        , centerWidgets = []
+        , endWidgets = map lift
             [ batteryBarNew defaultBatteryConfig 1.0
             , makeContents clock "Cpu"
             -- , makeContents systrayNew "Cpu"
@@ -241,7 +252,7 @@ main = do
         , barHeight = (underlineHeight myHUDConfig + windowIconSize myHUDConfig + 15)
         , widgetSpacing = 0
         }
-  withToggleSupport taffyConfig
+  dyreTaffybar $ handleDBusToggles $ toTaffyConfig simpleTaffyConfig
 
 -- Local Variables:
 -- flycheck-ghc-args: ("-Wno-missing-signatures")