gtk-sni-tray 0.1.14.2 → 0.1.15.0

raw patch · 6 files changed

+409/−89 lines, 6 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +11/−0
• README.md +10/−0
• app/Main.hs +76/−3
• gtk-sni-tray.cabal +2/−1
• src/StatusNotifier/Icon/Pixbuf.hs +149/−0
• src/StatusNotifier/Tray.hs +161/−85

@@ -1,5 +1,16 @@ # Changelog for gtk-sni-tray +## 0.1.15.0++- Fix: respect the user's GTK icon theme when an SNI item provides IconThemePath+  (and handle IconThemePath values that point inside a theme directory).+- Add icon preference support (choose themed icons vs pixmaps when both are+  provided) and expose it in the standalone executable with `--icon-preference`.+- Add optional icon recoloring in the standalone executable with `--icon-recolor`.+- Nix: improve flake dev shell environment so `cabal new-run` can find icon+  themes and gdk-pixbuf loaders.+- Development: add `scripts/fmt` and `scripts/fmt-check` for ormolu formatting.+ ## 0.1.14.2  - Relax executable `optparse-applicative` upper bound to `< 0.20` for GHC 9.12 snapshots.

@@ -38,3 +38,13 @@  If you see a Cabal error about missing pkg-config packages, `scripts/cabal-run` does a quick preflight check and prints a more direct message.++Development+-----------++Formatting is done with `ormolu` (available in the flake dev shell):++```sh+scripts/fmt+scripts/fmt-check+```

@@ -17,6 +17,7 @@ import           Graphics.UI.GIGtkStrut import           Options.Applicative import qualified StatusNotifier.Host.Service as Host+import qualified StatusNotifier.Icon.Pixbuf as IconPixbuf import           StatusNotifier.TransparentWindow import           StatusNotifier.Tray import           System.Log.Logger@@ -34,6 +35,12 @@ data BackendChoice = BackendAuto | BackendX11Choice | BackendWaylandChoice   deriving (Eq, Show, Read) +data IconRecolorMode+  = IconRecolorNone+  | IconRecolorMono+  | IconRecolorDuotone+  deriving (Eq, Show, Read)+ detectBackend :: IO Backend detectBackend = do   supported <- GtkLayerShell.isSupported@@ -474,6 +481,40 @@   <> value (5 % 7)   ) +iconPreferenceP :: Parser TrayIconPreference+iconPreferenceP =+  option (eitherReader parsePref)+    ( long "icon-preference"+        <> help "Icon preference when both are provided: pixmaps (default) | themed"+        <> value PreferPixmaps+        <> metavar "PREFERENCE"+    )+  where+    parsePref s =+      case map toLower s of+        "pixmaps" -> Right PreferPixmaps+        "pixmap" -> Right PreferPixmaps+        "themed" -> Right PreferThemedIcons+        "theme" -> Right PreferThemedIcons+        _ -> Left "expected one of: pixmaps, themed"++iconRecolorModeP :: Parser IconRecolorMode+iconRecolorModeP =+  option (eitherReader parseMode)+    ( long "icon-recolor"+        <> help "Recolor icons based on their alpha mask: none (default) | mono | duotone"+        <> value IconRecolorNone+        <> metavar "MODE"+    )+  where+    parseMode s =+      case map toLower s of+        "none" -> Right IconRecolorNone+        "mono" -> Right IconRecolorMono+        "duo" -> Right IconRecolorDuotone+        "duotone" -> Right IconRecolorDuotone+        _ -> Left "expected one of: none, mono, duotone"+ menuBackendP :: Parser MenuBackend menuBackendP =   option (eitherReader parseMenuBackend)@@ -513,9 +554,11 @@              -> Rational              -> Rational              -> MenuBackend+             -> TrayIconPreference+             -> IconRecolorMode              -> IO () buildWindows pos align size padding monitors priority backendChoice maybeColorString expand-             centerIcons startWatcher noStrut barLength overlayScale menuBackend = do+             centerIcons startWatcher noStrut barLength overlayScale menuBackend iconPreference iconRecolorMode = do   _ <- Gtk.init Nothing   logger <- getLogger "StatusNotifier"   saveGlobalLogger $ setLevel priority logger@@ -569,12 +612,41 @@                 TopPos -> Gtk.OrientationHorizontal                 BottomPos -> Gtk.OrientationHorizontal                 _ -> Gtk.OrientationVertical+            mixWord8 t a b =+              let ta = fromIntegral a :: Double+                  tb = fromIntegral b :: Double+                  out = ta + max 0 (min 1 t) * (tb - ta)+              in fromIntegral (max (0 :: Int) (min 255 (round out)))+            mixRgb8 t (IconPixbuf.Rgb8 r g b) (IconPixbuf.Rgb8 r2 g2 b2) =+              IconPixbuf.Rgb8 (mixWord8 t r r2) (mixWord8 t g g2) (mixWord8 t b b2)+            mkIconTransform =+              case iconRecolorMode of+                IconRecolorNone -> Nothing+                IconRecolorMono ->+                  Just $ \image pb -> do+                    ctx <- Gtk.widgetGetStyleContext image+                    fg <- Gtk.styleContextGetColor ctx [Gtk.StateFlagsNormal]+                    fg8 <- IconPixbuf.rgb8FromGdkRGBA fg+                    mpb <- IconPixbuf.recolorPixbufMonochrome fg8 pb+                    return $ fromMaybe pb mpb+                IconRecolorDuotone ->+                  Just $ \image pb -> do+                    ctx <- Gtk.widgetGetStyleContext image+                    fg <- Gtk.styleContextGetColor ctx [Gtk.StateFlagsNormal]+                    fg8 <- IconPixbuf.rgb8FromGdkRGBA fg+                    let black = IconPixbuf.Rgb8 0 0 0+                        white = IconPixbuf.Rgb8 255 255 255+                        dark = mixRgb8 0.35 fg8 black+                        light = mixRgb8 0.35 fg8 white+                    mpb <- IconPixbuf.recolorPixbufDuotone dark light pb+                    return $ fromMaybe pb mpb         tray <--          buildTray host client+          buildTrayWithPixbufTransform host client             TrayParams             { trayOrientation = orientation             , trayImageSize = Expand             , trayIconExpand = expand+            , trayIconPreference = iconPreference             , trayAlignment = align             , trayOverlayScale = overlayScale             , trayLeftClickAction = Activate@@ -583,6 +655,7 @@             , trayMenuBackend = menuBackend             , trayCenterIcons = centerIcons             }+            mkIconTransform         window <- Gtk.windowNew Gtk.WindowTypeToplevel         Gtk.windowSetResizable window False         Gtk.windowSetSkipTaskbarHint window True@@ -616,7 +689,7 @@   buildWindows <$> positionP <*> alignmentP <*> sizeP <*> paddingP <*>   monitorNumberP <*> logP <*> backendChoiceP <*> colorP <*> expandP <*>   centerIconsP <*> startWatcherP <*>-  noStrutP <*> barLengthP <*> overlayScaleP <*> menuBackendP+  noStrutP <*> barLengthP <*> overlayScaleP <*> menuBackendP <*> iconPreferenceP <*> iconRecolorModeP  versionOption :: Parser (a -> a) versionOption = infoOption

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           gtk-sni-tray-version:        0.1.14.2+version:        0.1.15.0 synopsis:       A standalone StatusNotifierItem/AppIndicator tray description:    Please see the README on Github at <https://github.com/IvanMalison/gtk-sni-tray#readme> category:       System@@ -27,6 +27,7 @@  library   exposed-modules:+      StatusNotifier.Icon.Pixbuf       StatusNotifier.TransparentWindow       StatusNotifier.Tray   other-modules:

@@ -0,0 +1,149 @@+module StatusNotifier.Icon.Pixbuf+  ( Rgb8 (..),+    rgb8FromGdkRGBA,+    recolorPixbufMonochrome,+    recolorPixbufMonochromeRGBA,+    recolorPixbufDuotone,+    recolorPixbufDuotoneRGBA,+  )+where++import Control.Monad (forM_)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Unsafe as BSU+import Data.Word (Word8)+import Foreign.Ptr (Ptr, castPtr, plusPtr)+import Foreign.Storable (peekByteOff, pokeByteOff)+import qualified GI.Gdk as Gdk+import qualified GI.GdkPixbuf.Objects.Pixbuf as GdkPixbuf++data Rgb8 = Rgb8+  { rgb8Red :: !Word8,+    rgb8Green :: !Word8,+    rgb8Blue :: !Word8+  }+  deriving (Eq, Show)++clamp01 :: Double -> Double+clamp01 x+  | x < 0 = 0+  | x > 1 = 1+  | otherwise = x++toWord8 :: Double -> Word8+toWord8 x = round (clamp01 x * 255.0)++rgb8FromGdkRGBA :: Gdk.RGBA -> IO Rgb8+rgb8FromGdkRGBA rgba = do+  r <- Gdk.getRGBARed rgba+  g <- Gdk.getRGBAGreen rgba+  b <- Gdk.getRGBABlue rgba+  pure $ Rgb8 (toWord8 r) (toWord8 g) (toWord8 b)++lerpWord8 :: Double -> Word8 -> Word8 -> Word8+lerpWord8 t a b =+  let ta = fromIntegral a :: Double+      tb = fromIntegral b :: Double+      out = ta + clamp01 t * (tb - ta)+   in fromIntegral (max (0 :: Int) (min 255 (round out)))++pixelLuminance01 :: Word8 -> Word8 -> Word8 -> Double+pixelLuminance01 r g b =+  let rf = fromIntegral r / 255.0 :: Double+      gf = fromIntegral g / 255.0 :: Double+      bf = fromIntegral b / 255.0 :: Double+   in clamp01 (0.2126 * rf + 0.7152 * gf + 0.0722 * bf)++-- | Replace the RGB channels of the pixbuf with the given color while preserving+-- the alpha channel. This is the "extract shapes and recolor" primitive: the+-- icon's shape comes from its alpha mask.+recolorPixbufMonochrome :: Rgb8 -> GdkPixbuf.Pixbuf -> IO (Maybe GdkPixbuf.Pixbuf)+recolorPixbufMonochrome (Rgb8 r g b) pixbuf = do+  mpb <- GdkPixbuf.pixbufCopy pixbuf+  case mpb of+    Nothing -> pure Nothing+    Just pb -> do+      recolorInPlace pb $ \_origR _origG _origB _a -> (r, g, b)+      pure (Just pb)++recolorPixbufMonochromeRGBA :: Gdk.RGBA -> GdkPixbuf.Pixbuf -> IO (Maybe GdkPixbuf.Pixbuf)+recolorPixbufMonochromeRGBA rgba pixbuf = do+  rgb <- rgb8FromGdkRGBA rgba+  recolorPixbufMonochrome rgb pixbuf++-- | Map the original pixel luminance to a color between the two provided colors,+-- while preserving the alpha channel.+recolorPixbufDuotone :: Rgb8 -> Rgb8 -> GdkPixbuf.Pixbuf -> IO (Maybe GdkPixbuf.Pixbuf)+recolorPixbufDuotone (Rgb8 r0 g0 b0) (Rgb8 r1 g1 b1) pixbuf = do+  mpb <- GdkPixbuf.pixbufCopy pixbuf+  case mpb of+    Nothing -> pure Nothing+    Just pb -> do+      recolorInPlace pb $ \origR origG origB _a ->+        let t = pixelLuminance01 origR origG origB+         in ( lerpWord8 t r0 r1,+              lerpWord8 t g0 g1,+              lerpWord8 t b0 b1+            )+      pure (Just pb)++recolorPixbufDuotoneRGBA :: Gdk.RGBA -> Gdk.RGBA -> GdkPixbuf.Pixbuf -> IO (Maybe GdkPixbuf.Pixbuf)+recolorPixbufDuotoneRGBA rgba0 rgba1 pixbuf = do+  c0 <- rgb8FromGdkRGBA rgba0+  c1 <- rgb8FromGdkRGBA rgba1+  recolorPixbufDuotone c0 c1 pixbuf++recolorInPlace ::+  GdkPixbuf.Pixbuf ->+  (Word8 -> Word8 -> Word8 -> Word8 -> (Word8, Word8, Word8)) ->+  IO ()+recolorInPlace pb computeRgb = do+  width <- fromIntegral <$> GdkPixbuf.pixbufGetWidth pb+  height <- fromIntegral <$> GdkPixbuf.pixbufGetHeight pb+  rowStride <- fromIntegral <$> GdkPixbuf.pixbufGetRowstride pb+  nChannels <- fromIntegral <$> GdkPixbuf.pixbufGetNChannels pb+  hasAlpha <- GdkPixbuf.pixbufGetHasAlpha pb+  pixelsBs <- GdkPixbuf.pixbufGetPixels pb++  let bytesPerPixel = nChannels+      alphaOff = if hasAlpha then 3 else (-1)++      -- Hard stop: unexpected pixbuf format.+      validFormat = bytesPerPixel == 3 || bytesPerPixel == 4++      readChannel :: Ptr Word8 -> Int -> IO Word8+      readChannel p off = peekByteOff p off++      writeChannel :: Ptr Word8 -> Int -> Word8 -> IO ()+      writeChannel p off v = pokeByteOff p off v++  if width <= 0 || height <= 0 || not validFormat || BS.null pixelsBs+    then pure ()+    else+      -- 'pixbufGetPixels' gives us a view of the pixbuf's pixel buffer. We mutate+      -- in-place after copying the pixbuf so the caller gets an isolated buffer.+      BSU.unsafeUseAsCString pixelsBs $ \pixels0 -> do+        let pixels :: Ptr Word8+            pixels = castPtr pixels0++            rows :: Int -> Ptr Word8+            rows y = pixels `plusPtr` (y * rowStride)++            pixelPtr :: Ptr Word8 -> Int -> Ptr Word8+            pixelPtr row x = row `plusPtr` (x * bytesPerPixel)++        forM_ [0 .. height - 1] $ \y -> do+          let row = rows y+          forM_ [0 .. width - 1] $ \x -> do+            let p = pixelPtr row x+            a <- if hasAlpha then readChannel p alphaOff else pure 255+            if a == 0+              then pure ()+              else do+                origR <- readChannel p 0+                origG <- readChannel p 1+                origB <- readChannel p 2+                let (outR, outG, outB) = computeRgb origR origG origB a+                writeChannel p 0 outR+                writeChannel p 1 outG+                writeChannel p 2 outB

@@ -30,7 +30,6 @@ import           GI.GLib.Structs.Bytes import qualified GI.Gdk as Gdk import           GI.Gdk.Enums-import           GI.Gdk.Objects.Screen import           GI.Gdk.Structs.EventScroll import           GI.GdkPixbuf.Enums import           GI.GdkPixbuf.Objects.Pixbuf as Gdk@@ -50,6 +49,10 @@ trayLogger :: Priority -> String -> IO () trayLogger = logM "StatusNotifier.Tray" +-- | Optional post-processing hook for item icons. This is applied after scaling+-- and overlay composition.+type PixbufTransform = Gtk.Image -> Pixbuf -> IO Pixbuf+ logItemInfo :: ItemInfo -> String -> IO () logItemInfo info message =   trayLogger INFO $ printf "%s - %s pixmap count: %s" message@@ -96,20 +99,47 @@ themeLoadFlags :: [IconLookupFlags] themeLoadFlags = [IconLookupFlagsGenericFallback, IconLookupFlagsUseBuiltin] -getThemeWithDefaultFallbacks :: String -> IO IconTheme-getThemeWithDefaultFallbacks themePath = do-  themeForIcon <- iconThemeNew-  defaultTheme <- iconThemeGetDefault--  _ <- runMaybeT $ do-    screen <- MaybeT screenGetDefault-    lift $ iconThemeSetScreen themeForIcon screen--  filePaths <- iconThemeGetSearchPath defaultTheme-  iconThemeAppendSearchPath themeForIcon themePath-  mapM_ (iconThemeAppendSearchPath themeForIcon) filePaths+getThemeWithOptionalSearchPath :: Maybe String -> IO IconTheme+getThemeWithOptionalSearchPath themePath = do+  theme <- iconThemeGetDefault+  forM_ (themePath >>= nonEmpty) $ \p -> do+    -- Respect the user's configured icon theme by using GTK's default theme+    -- object, but include any item-provided IconThemePath as an additional+    -- search path.+    --+    -- Some items provide IconThemePath pointing inside a theme dir, e.g.:+    --   .../Papirus/64x64/mimetypes+    -- GTK expects search paths that contain theme directories, so also try to+    -- append the parent directory of any ancestor that contains index.theme.+    pathsToAppend <- pathsForIconThemePath p+    existing <- iconThemeGetSearchPath theme+    forM_ pathsToAppend $ \p' ->+      unless (p' `elem` existing) $ iconThemeAppendSearchPath theme p'+  return theme+  where+    nonEmpty "" = Nothing+    nonEmpty x = Just x -  return themeForIcon+pathsForIconThemePath :: FilePath -> IO [FilePath]+pathsForIconThemePath rawPath = do+  mThemeDir <- findAncestorWithIndexTheme 8 rawPath+  let base =+        case mThemeDir of+          Nothing -> []+          Just themeDir -> [takeDirectory themeDir]+  return $ nub $ base ++ [rawPath]+  where+    findAncestorWithIndexTheme :: Int -> FilePath -> IO (Maybe FilePath)+    findAncestorWithIndexTheme 0 _ = return Nothing+    findAncestorWithIndexTheme n p = do+      hasIndex <- doesFileExist (p </> "index.theme")+      if hasIndex+        then return (Just p)+        else do+          let parent = takeDirectory p+          if parent == p+            then return Nothing+            else findAncestorWithIndexTheme (n - 1) parent  catchGErrorsAsLeft :: IO a -> IO (Either GError a) catchGErrorsAsLeft action = catch (Right <$> action) (return . Left)@@ -134,36 +164,38 @@ getIconPixbufByName :: Int32 -> T.Text -> Maybe String -> IO (Maybe Pixbuf) getIconPixbufByName size name themePath = do   trayLogger DEBUG $ printf "Getting Pixbuf from name for %s" name-  let nonEmptyThemePath = themePath >>= (\x -> if x == "" then Nothing else Just x)-  themeForIcon <--    maybe iconThemeGetDefault getThemeWithDefaultFallbacks nonEmptyThemePath+  themeForIcon <- getThemeWithOptionalSearchPath themePath    let panelName = T.pack $ printf "%s-panel" name-  hasPanelIcon <- iconThemeHasIcon themeForIcon panelName-  hasIcon <- iconThemeHasIcon themeForIcon name--  if hasIcon || hasPanelIcon+  -- Avoid relying on iconThemeHasIcon: it can be overly strict when fallback+  -- loading is enabled. Just try to load and fall back if it fails.+  let tryLoad :: T.Text -> IO (Maybe Pixbuf)+      tryLoad iconName =+        catchAny (iconThemeLoadIcon themeForIcon iconName size themeLoadFlags)+                 (const $ pure Nothing) -  then do-    let targetName = if hasPanelIcon then panelName else name-    trayLogger DEBUG $ printf "Found icon %s in theme" name-    catchAny (iconThemeLoadIcon themeForIcon targetName size themeLoadFlags)-             (const $ pure Nothing)+  themedPixbuf <- do+    pbPanel <- tryLoad panelName+    case pbPanel of+      Just _ -> return pbPanel+      Nothing -> tryLoad name -  else do-    trayLogger DEBUG $ printf "Trying to load icon %s as filepath" name-    -- Try to load the icon as a filepath-    let nameString = T.unpack name-    fileExists <- doesFileExist nameString-    maybeFile <- if fileExists-    then return $ Just nameString-    else fmap join $ sequenceA $ getIconPathFromThemePath nameString <$> themePath+  case themedPixbuf of+    Just _ -> return themedPixbuf+    Nothing -> do+      trayLogger DEBUG $ printf "Trying to load icon %s as filepath" name+      -- Try to load the icon as a filepath+      let nameString = T.unpack name+      fileExists <- doesFileExist nameString+      maybeFile <- if fileExists+      then return $ Just nameString+      else fmap join $ sequenceA $ getIconPathFromThemePath nameString <$> themePath #if MIN_VERSION_gi_gdkpixbuf(2,0,26)-    let handleResult = fmap join . sequenceA+      let handleResult = fmap join . sequenceA #else-    let handleResult = sequenceA+      let handleResult = sequenceA #endif-    handleResult $ safePixbufNewFromFile <$> maybeFile+      handleResult $ safePixbufNewFromFile <$> maybeFile  getIconPathFromThemePath :: String -> String -> IO (Maybe String) getIconPathFromThemePath name themePath = if name == "" then return Nothing else do@@ -378,10 +410,18 @@ trayMatchIsMenu expected =   mkTrayItemMatcher "is-menu" $ \info -> itemIsMenu info == expected +-- | Controls whether to prefer application-provided pixmaps or themed icons+-- when both are present. Some items provide both.+data TrayIconPreference+  = PreferPixmaps+  | PreferThemedIcons+  deriving (Eq, Show, Read)+ data TrayParams = TrayParams   { trayOrientation :: Gtk.Orientation   , trayImageSize :: TrayImageSize   , trayIconExpand :: Bool+  , trayIconPreference :: TrayIconPreference   , trayAlignment :: StrutAlignment   , trayOverlayScale :: Rational   , trayLeftClickAction :: TrayClickAction@@ -396,6 +436,7 @@   { trayOrientation = Gtk.OrientationHorizontal   , trayImageSize = Expand   , trayIconExpand = False+  , trayIconPreference = PreferPixmaps   , trayAlignment = End   , trayOverlayScale = 2 % 5   , trayLeftClickAction = Activate@@ -407,10 +448,18 @@  buildTray :: Host -> Client -> TrayParams -> IO Gtk.Box buildTray host client params =-  buildTrayWithPriority host client params defaultTrayPriorityConfig+  buildTrayWithPixbufTransform host client params Nothing  buildTrayWithPriority :: Host -> Client -> TrayParams -> TrayPriorityConfig -> IO Gtk.Box-buildTrayWithPriority Host+buildTrayWithPriority host client params priorityConfig =+  buildTrayWithPriorityAndPixbufTransform host client params priorityConfig Nothing++buildTrayWithPixbufTransform :: Host -> Client -> TrayParams -> Maybe PixbufTransform -> IO Gtk.Box+buildTrayWithPixbufTransform host client params mTransform =+  buildTrayWithPriorityAndPixbufTransform host client params defaultTrayPriorityConfig mTransform++buildTrayWithPriorityAndPixbufTransform :: Host -> Client -> TrayParams -> TrayPriorityConfig -> Maybe PixbufTransform -> IO Gtk.Box+buildTrayWithPriorityAndPixbufTransform Host             { itemInfoMap = getInfoMap             , addUpdateHandler = addUHandler             , removeUpdateHandler = removeUHandler@@ -419,6 +468,7 @@           TrayParams { trayOrientation = orientation                      , trayImageSize = imageSize                      , trayIconExpand = shouldExpand+                     , trayIconPreference = iconPreference                      , trayAlignment = alignment                      , trayOverlayScale = overlayScale                      , trayLeftClickAction = leftClickAction@@ -427,7 +477,8 @@                      , trayMenuBackend = menuBackend                      , trayCenterIcons = centerIcons                      }-          TrayPriorityConfig { trayPriorityMatchers = priorityMatchers } = do+          TrayPriorityConfig { trayPriorityMatchers = priorityMatchers }+          mTransform = do   trayLogger INFO "Building tray"    trayBox <- Gtk.boxNew orientation 0@@ -482,6 +533,13 @@           \(newIndex, child) ->             Gtk.boxReorderChild trayBox child (fromIntegral newIndex) +      applyTransform :: Gtk.Image -> Maybe Pixbuf -> IO (Maybe Pixbuf)+      applyTransform _ Nothing = return Nothing+      applyTransform image (Just pb) =+        case mTransform of+          Nothing -> return (Just pb)+          Just f -> Just <$> f image pb+       updateIconFromInfo info@ItemInfo { itemServiceName = name } =         getContext name >>= updateIcon         where updateIcon Nothing = updateHandler ItemAdded info@@ -489,7 +547,9 @@                 size <- case imageSize of                           TrayImageSize size -> return size                           Expand -> Gtk.widgetGetAllocation image >>= getSize-                getScaledPixBufFromInfo size info >>=+                getScaledPixBufFromInfo size info+                  >>= applyTransform image+                  >>=                                   let handlePixbuf mpbuf =                                         if isJust mpbuf                                         then Gtk.imageSetFromPixbuf image mpbuf@@ -526,56 +586,58 @@           Gtk.widgetGetStyleContext eventBox >>=             flip Gtk.styleContextAddClass "tray-icon-button" -          image <--            case imageSize of-              Expand -> do-                image <- Gtk.imageNew-                lastAllocation <- MV.newMVar Nothing+          image <- Gtk.imageNew -                let setPixbuf allocation =-                      do-                        size <- getSize allocation+          case imageSize of+            Expand -> do+              lastAllocation <- MV.newMVar Nothing -                        actualWidth <- Gdk.getRectangleWidth allocation-                        actualHeight <- Gdk.getRectangleHeight allocation+              let setPixbuf allocation =+                    do+                      size <- getSize allocation -                        requestResize <- MV.modifyMVar lastAllocation $ \previous ->-                          let thisTime = Just (size, actualWidth, actualHeight)-                          in return (thisTime, thisTime /= previous)+                      actualWidth <- Gdk.getRectangleWidth allocation+                      actualHeight <- Gdk.getRectangleHeight allocation -                        trayLogger DEBUG $-                                   printf-                                   ("Allocating image size %s, width %s," <>-                                    " height %s, resize %s")-                                   (show size)-                                   (show actualWidth)-                                   (show actualHeight)-                                   (show requestResize)+                      requestResize <- MV.modifyMVar lastAllocation $ \previous ->+                        let thisTime = Just (size, actualWidth, actualHeight)+                        in return (thisTime, thisTime /= previous) -                        when requestResize $ do-                          trayLogger DEBUG "Requesting resize"-                          pixBuf <- getInfo info serviceName >>=-                                    getScaledPixBufFromInfo size-                          when (isNothing pixBuf) $-                               trayLogger WARNING $-                                          printf "Got null pixbuf for info %s" $-                                          showInfo info-                          Gtk.imageSetFromPixbuf image pixBuf-                          void $ traverse-                                 (\pb -> do-                                    width <- pixbufGetWidth pb-                                    height <- pixbufGetHeight pb-                                    Gtk.widgetSetSizeRequest image width height)-                                 pixBuf-                          void (Gdk.threadsAddIdle GLib.PRIORITY_DEFAULT $-                                   Gtk.widgetQueueResize image >> return False)+                      trayLogger DEBUG $+                                 printf+                                 ("Allocating image size %s, width %s," <>+                                  " height %s, resize %s")+                                 (show size)+                                 (show actualWidth)+                                 (show actualHeight)+                                 (show requestResize) -                _ <- Gtk.onWidgetSizeAllocate image setPixbuf-                return image-              TrayImageSize size -> do-                pixBuf <- getScaledPixBufFromInfo size info-                Gtk.imageNewFromPixbuf pixBuf+                      when requestResize $ do+                        trayLogger DEBUG "Requesting resize"+                        pixBuf0 <- getInfo info serviceName >>=+                                  getScaledPixBufFromInfo size+                        pixBuf <- applyTransform image pixBuf0+                        when (isNothing pixBuf) $+                             trayLogger WARNING $+                                        printf "Got null pixbuf for info %s" $+                                        showInfo info+                        Gtk.imageSetFromPixbuf image pixBuf+                        void $ traverse+                               (\pb -> do+                                  width <- pixbufGetWidth pb+                                  height <- pixbufGetHeight pb+                                  Gtk.widgetSetSizeRequest image width height)+                               pixBuf+                        void (Gdk.threadsAddIdle GLib.PRIORITY_DEFAULT $+                                 Gtk.widgetQueueResize image >> return False) +              _ <- Gtk.onWidgetSizeAllocate image setPixbuf+              return ()+            TrayImageSize size -> do+              pixBuf0 <- getScaledPixBufFromInfo size info+              pixBuf <- applyTransform image pixBuf0+              Gtk.imageSetFromPixbuf image pixBuf+           Gtk.widgetGetStyleContext image >>=              flip Gtk.styleContextAddClass "tray-icon-image" @@ -778,9 +840,23 @@               if BS.length p == 0               then return Nothing               else getIconPixbufFromByteString w h p+            getFromThemed =+              if name == ""+              then return Nothing+              else getIconPixbufByName size (T.pack name) mpath+            firstJustM a b = do+              ma <- a+              case ma of+                Just _ -> return ma+                Nothing -> b+         if null pixmaps         then getIconPixbufByName size (T.pack name) mpath-        else getFromPixmaps selectedPixmap+        else case iconPreference of+               PreferThemedIcons ->+                 firstJustM getFromThemed (getFromPixmaps selectedPixmap)+               PreferPixmaps ->+                 firstJustM (getFromPixmaps selectedPixmap) getFromThemed        uiUpdateHandler updateType info =         void $ Gdk.threadsAddIdle GLib.PRIORITY_DEFAULT $