diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -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. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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 +``` diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -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 diff --git a/gtk-sni-tray.cabal b/gtk-sni-tray.cabal --- a/gtk-sni-tray.cabal +++ b/gtk-sni-tray.cabal @@ -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 category: System @@ -27,6 +27,7 @@ library exposed-modules: + StatusNotifier.Icon.Pixbuf StatusNotifier.TransparentWindow StatusNotifier.Tray other-modules: diff --git a/src/StatusNotifier/Icon/Pixbuf.hs b/src/StatusNotifier/Icon/Pixbuf.hs new file mode 100644 --- /dev/null +++ b/src/StatusNotifier/Icon/Pixbuf.hs @@ -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 diff --git a/src/StatusNotifier/Tray.hs b/src/StatusNotifier/Tray.hs --- a/src/StatusNotifier/Tray.hs +++ b/src/StatusNotifier/Tray.hs @@ -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 $