taffybar 5.2.0 → 5.2.1
raw patch · 6 files changed
+82/−170 lines, 6 files
Files
- CHANGELOG.md +12/−0
- app/AppearanceSnap.hs +23/−98
- app/AppearanceSnapHyprland.hs +19/−36
- src/System/Taffybar/WindowIcon.hs +9/−6
- taffybar.cabal +1/−1
- test/unit/System/Taffybar/AppearanceSpec.hs +18/−29
CHANGELOG.md view
@@ -1,5 +1,17 @@ # Unreleased +# 5.2.1++## Fixes++* Guard EWMH window-icon property subscriptions behind X11 context presence to+ avoid non-X11 build/runtime failures.++## Tests++* Simplify appearance snapshot apps/tests to a single workspaces mode by+ removing legacy channel-workspaces snapshot wiring and flags.+ # 5.2.0 ## New Features
app/AppearanceSnap.hs view
@@ -76,15 +76,7 @@ ) import System.Taffybar.Util (postGUIASync) import qualified System.Taffybar.Widget.Windows as Windows-import qualified System.Taffybar.Widget.Workspaces as ChannelWorkspaces-import qualified System.Taffybar.Widget.Workspaces.Config as WorkspaceConfig-import System.Taffybar.Widget.Workspaces.EWMH- ( WorkspacesConfig,- getWindowIconPixbufFromEWMH,- sortWindowsByStackIndex,- workspacesNew,- )-import qualified System.Taffybar.Widget.Workspaces.EWMH as Workspaces+import qualified System.Taffybar.Widget.Workspaces as Workspaces import Text.Read (readMaybe) import UnliftIO.Temporary (withSystemTempDirectory) @@ -92,18 +84,12 @@ { outFile :: FilePath, cssFile :: FilePath, layoutMode :: LayoutMode,- workspaceWidgetMode :: WorkspaceWidgetMode, expectedTopStrut :: Maybe Int } data LayoutMode = LayoutLegacy | LayoutLevels | LayoutWindowsTitleStress deriving (Eq, Show) -data WorkspaceWidgetMode- = UseLegacyWorkspaces- | UseChannelWorkspaces- deriving (Eq, Show)- snapshotWatchdogTimeoutUsec :: Int snapshotWatchdogTimeoutUsec = 60_000_000 @@ -113,7 +99,6 @@ { outFile = outPath, cssFile = cssPath, layoutMode = mode,- workspaceWidgetMode = wsMode, expectedTopStrut = mExpectedTopStrut } <- parseArgs =<< getArgs@@ -156,7 +141,7 @@ -- -- If this fails, the parent Xvfb teardown will still kill the X server, -- which causes the WM to exit.- res <- runUnderWm wmProc outPath cssPath mode wsMode mExpectedTopStrut+ res <- runUnderWm wmProc outPath cssPath mode mExpectedTopStrut killProcessNoWait wmProc pure res @@ -167,10 +152,9 @@ FilePath -> FilePath -> LayoutMode ->- WorkspaceWidgetMode -> Maybe Int -> IO ExitCode-runUnderWm wmProc outPath cssPath mode wsMode mExpectedTopStrut = do+runUnderWm wmProc outPath cssPath mode mExpectedTopStrut = do ctxVar <- (newEmptyMVar :: IO (MVar Context)) resultVar <- (newEmptyMVar :: IO (MVar (Either String BL.ByteString))) doneVar <- (newEmptyMVar :: IO (MVar ExitCode))@@ -185,38 +169,25 @@ void $ forkIO $ watchdogThread wmProc ctxVar resultVar doneVar snapshotWatchdogTimeoutUsec barUnique <- newUnique- let wsCfgDefault = def :: WorkspacesConfig- legacyWsCfg =- wsCfgDefault- { Workspaces.workspacesConfig =- (Workspaces.workspacesConfig wsCfgDefault)- { -- Avoid font-dependent output in the appearance golden: we only care- -- that icons/layout render deterministically.- WorkspaceConfig.labelSetter = const (pure ""),- WorkspaceConfig.maxIcons = Just 1,- WorkspaceConfig.minIcons = 1,- WorkspaceConfig.getWindowIconPixbuf = getWindowIconPixbufFromEWMH,- WorkspaceConfig.iconSort = sortWindowsByStackIndex- }- }- channelWsCfg =- ChannelWorkspaces.defaultEWMHWorkspacesConfig- { ChannelWorkspaces.labelSetter = const (pure ""),- ChannelWorkspaces.maxIcons = Just 1,- ChannelWorkspaces.minIcons = 1,- ChannelWorkspaces.showWorkspaceFn = const True+ let wsCfg =+ Workspaces.defaultEWMHWorkspacesConfig+ { -- Avoid font-dependent output in the appearance golden: we only care+ -- that icons/layout render deterministically.+ Workspaces.labelSetter = const (pure ""),+ Workspaces.maxIcons = Just 1,+ Workspaces.minIcons = 1,+ Workspaces.getWindowIconPixbuf = Workspaces.getWindowIconPixbufFromEWMH,+ Workspaces.iconSort = Workspaces.sortWindowsByStackIndex,+ Workspaces.showWorkspaceFn = const True }- workspaceWidget =- case wsMode of- UseLegacyWorkspaces -> workspacesNew legacyWsCfg- UseChannelWorkspaces -> ChannelWorkspaces.workspacesNew channelWsCfg+ workspaceWidget = Workspaces.workspacesNew wsCfg barCfg = buildBarConfig workspaceWidget barUnique mode cfg = def { dbusClientParam = Nothing, cssPaths = [cssPath], getBarConfigsParam = pure [barCfg],- startupHook = scheduleSnapshot ctxVar resultVar wsMode mExpectedTopStrut,+ startupHook = scheduleSnapshot ctxVar resultVar mExpectedTopStrut, errorMsg = Nothing } @@ -360,10 +331,9 @@ scheduleSnapshot :: MVar Context -> MVar (Either String BL.ByteString) ->- WorkspaceWidgetMode -> Maybe Int -> TaffyIO ()-scheduleSnapshot ctxVar resultVar wsMode mExpectedTopStrut = do+scheduleSnapshot ctxVar resultVar mExpectedTopStrut = do ctx <- ask liftIO $ void (tryPutMVar ctxVar ctx) liftIO $ void $ forkIO (pollLoop ctx)@@ -373,7 +343,7 @@ case done of Just _ -> pure () Nothing -> do- postGUIASync (trySnapshotOnGuiThread ctx' resultVar wsMode mExpectedTopStrut)+ postGUIASync (trySnapshotOnGuiThread ctx' resultVar mExpectedTopStrut) threadDelay 50_000 pollLoop ctx' @@ -467,10 +437,9 @@ trySnapshotOnGuiThread :: Context -> MVar (Either String BL.ByteString) ->- WorkspaceWidgetMode -> Maybe Int -> IO ()-trySnapshotOnGuiThread ctx resultVar wsMode mExpectedTopStrut = do+trySnapshotOnGuiThread ctx resultVar mExpectedTopStrut = do -- Read the windows list and snapshot the first bar window. ws <- readMVar (existingWindows ctx) case listToMaybe ws of@@ -486,9 +455,7 @@ mActualTop <- getDockTopStrut pure (mActualTop == Just expectedTop) -- Don't accept a snapshot until the bar has actually rendered.- -- Legacy mode checks icon colors, while channel mode has a weaker- -- readiness check because it does not use the legacy EWMH icon path.- when (strutReady && isSnapshotReady wsMode img) $+ when (strutReady && isSnapshotReady img) $ void (tryPutMVar resultVar (Right (JP.encodePng img))) getDockTopStrut :: IO (Maybe Int)@@ -518,44 +485,8 @@ (_left : _right : top : _rest) <- mStrut pure (fromIntegral top) -isSnapshotReady :: WorkspaceWidgetMode -> JP.Image JP.PixelRGBA8 -> Bool-isSnapshotReady wsMode img =- case wsMode of- UseLegacyWorkspaces -> imageHasTestIcons img- UseChannelWorkspaces -> imageHasOpaqueContent img--imageHasTestIcons :: JP.Image JP.PixelRGBA8 -> Bool-imageHasTestIcons img =- let tol :: Int- tol = 40- opaqueThreshold :: Int- opaqueThreshold = 5000- near (JP.PixelRGBA8 r g b a) (tr, tg, tb) =- a > 200- && abs (fromIntegral r - tr) <= tol- && abs (fromIntegral g - tg) <= tol- && abs (fromIntegral b - tb) <= tol- redTarget :: (Int, Int, Int)- redTarget = (224, 58, 58)- greenTarget :: (Int, Int, Int)- greenTarget = (58, 224, 106)- w = JP.imageWidth img- h = JP.imageHeight img- go y seenR seenG opaqueCount- | y >= h = seenR && seenG && opaqueCount > opaqueThreshold- | otherwise =- let goX x sr sg oc- | x >= w = go (y + 1) sr sg oc- | otherwise =- let px = JP.pixelAt img x y- sr1 = sr || near px redTarget- sg1 = sg || near px greenTarget- oc1 =- oc- + (case px of JP.PixelRGBA8 _ _ _ a -> if a > 200 then 1 else 0)- in (sr1 && sg1 && oc1 > opaqueThreshold) || goX (x + 1) sr1 sg1 oc1- in goX 0 seenR seenG opaqueCount- in go 0 False False (0 :: Int)+isSnapshotReady :: JP.Image JP.PixelRGBA8 -> Bool+isSnapshotReady = imageHasOpaqueContent imageHasOpaqueContent :: JP.Image JP.PixelRGBA8 -> Bool imageHasOpaqueContent img =@@ -628,14 +559,10 @@ | "--windows-title-stress" `elem` args = LayoutWindowsTitleStress | "--levels" `elem` args = LayoutLevels | otherwise = LayoutLegacy- selectedWorkspaceWidgetMode =- if "--channel-workspaces" `elem` args- then UseChannelWorkspaces- else UseLegacyWorkspaces (mExpectedTopStrut, argsSansTopStrutFlag) = parseTopStrutFlag args argsSansFlags = filter- (`notElem` ["--levels", "--windows-title-stress", "--channel-workspaces"])+ (`notElem` ["--levels", "--windows-title-stress"]) argsSansTopStrutFlag in case argsSansFlags of ["--out", outPath, "--css", cssPath] ->@@ -644,7 +571,6 @@ { outFile = outPath, cssFile = cssPath, layoutMode = selectedLayoutMode,- workspaceWidgetMode = selectedWorkspaceWidgetMode, expectedTopStrut = mExpectedTopStrut } ["--css", cssPath, "--out", outPath] ->@@ -653,11 +579,10 @@ { outFile = outPath, cssFile = cssPath, layoutMode = selectedLayoutMode,- workspaceWidgetMode = selectedWorkspaceWidgetMode, expectedTopStrut = mExpectedTopStrut } _ ->- die "usage: taffybar-appearance-snap --out OUT.png --css appearance-test.css [--levels|--windows-title-stress] [--channel-workspaces] [--expect-top-strut N]"+ die "usage: taffybar-appearance-snap --out OUT.png --css appearance-test.css [--levels|--windows-title-stress] [--expect-top-strut N]" where parseTopStrutFlag :: [String] -> (Maybe Int, [String]) parseTopStrutFlag [] = (Nothing, [])
app/AppearanceSnapHyprland.hs view
@@ -51,24 +51,18 @@ TaffybarConfig (..), exitTaffybar, )-import qualified System.Taffybar.Widget.Workspaces as ChannelWorkspaces+import qualified System.Taffybar.Widget.Workspaces as Workspaces import UnliftIO.Temporary (withSystemTempDirectory) data Args = Args { outFile :: FilePath, cssFile :: FilePath,- layoutMode :: LayoutMode,- workspaceWidgetMode :: WorkspaceWidgetMode+ layoutMode :: LayoutMode } data LayoutMode = LayoutLegacy | LayoutLevels deriving (Eq, Show) -data WorkspaceWidgetMode- = UseLegacyWorkspaces- | UseChannelWorkspaces- deriving (Eq, Show)- snapshotWatchdogTimeoutUsec :: Int snapshotWatchdogTimeoutUsec = 60_000_000 @@ -77,8 +71,7 @@ Args { outFile = outPath, cssFile = cssPath,- layoutMode = mode,- workspaceWidgetMode = wsMode+ layoutMode = mode } <- parseArgs =<< getArgs @@ -117,7 +110,7 @@ createDirectoryIfMissing True (takeDirectory outPath) - runUnderHyprland outPath cssPath mode wsMode+ runUnderHyprland outPath cssPath mode exitWith ec @@ -125,9 +118,8 @@ FilePath -> FilePath -> LayoutMode ->- WorkspaceWidgetMode -> IO ExitCode-runUnderHyprland outPath cssPath mode wsMode = do+runUnderHyprland outPath cssPath mode = do ctxVar :: MVar Context <- newEmptyMVar resultVar :: MVar (Either String BL.ByteString) <- newEmptyMVar doneVar :: MVar ExitCode <- newEmptyMVar@@ -141,7 +133,7 @@ barUnique <- newUnique - let barCfg = buildBarConfig barUnique mode wsMode+ let barCfg = buildBarConfig barUnique mode cfg = def@@ -178,8 +170,8 @@ Gtk.widgetShowAll widget pure widget -buildBarConfig :: Unique -> LayoutMode -> WorkspaceWidgetMode -> BarConfig-buildBarConfig barUnique mode wsMode =+buildBarConfig :: Unique -> LayoutMode -> BarConfig+buildBarConfig barUnique mode = case mode of LayoutLegacy -> BarConfig@@ -228,16 +220,13 @@ strutPosition = TopPos } startWidget =- case wsMode of- UseLegacyWorkspaces -> testPillBoxWidget "test-pill" 56 20- UseChannelWorkspaces ->- ChannelWorkspaces.workspacesNew $- ChannelWorkspaces.defaultWorkspacesConfig- { ChannelWorkspaces.labelSetter = const (pure ""),- ChannelWorkspaces.maxIcons = Just 1,- ChannelWorkspaces.minIcons = 1,- ChannelWorkspaces.showWorkspaceFn = const True- }+ Workspaces.workspacesNew $+ Workspaces.defaultWorkspacesConfig+ { Workspaces.labelSetter = const (pure ""),+ Workspaces.maxIcons = Just 1,+ Workspaces.minIcons = 1,+ Workspaces.showWorkspaceFn = const True+ } scheduleSnapshot :: MVar Context -> MVar (Either String BL.ByteString) -> IORef (Maybe BL.ByteString) -> LayoutMode -> TaffyIO () scheduleSnapshot ctxVar resultVar lastShotRef mode = do@@ -393,13 +382,9 @@ if "--levels" `elem` args then LayoutLevels else LayoutLegacy- selectedWorkspaceWidgetMode =- if "--channel-workspaces" `elem` args- then UseChannelWorkspaces- else UseLegacyWorkspaces argsSansFlags = filter- (`notElem` ["--levels", "--channel-workspaces"])+ (`notElem` ["--levels"]) args in case argsSansFlags of ["--out", outPath, "--css", cssPath] ->@@ -407,20 +392,18 @@ Args { outFile = outPath, cssFile = cssPath,- layoutMode = selectedLayoutMode,- workspaceWidgetMode = selectedWorkspaceWidgetMode+ layoutMode = selectedLayoutMode } ["--css", cssPath, "--out", outPath] -> pure Args { outFile = outPath, cssFile = cssPath,- layoutMode = selectedLayoutMode,- workspaceWidgetMode = selectedWorkspaceWidgetMode+ layoutMode = selectedLayoutMode } _ -> fail- "usage: taffybar-appearance-snap-hyprland --out OUT.png --css appearance-test.css [--levels] [--channel-workspaces]"+ "usage: taffybar-appearance-snap-hyprland --out OUT.png --css appearance-test.css [--levels]" die :: String -> IO a die msg = do
src/System/Taffybar/WindowIcon.hs view
@@ -9,9 +9,9 @@ import qualified Control.Concurrent.MVar as MV import Control.Monad import Control.Monad.IO.Class-import Control.Monad.Trans.Reader (ask, runReaderT) import Control.Monad.Trans.Class import Control.Monad.Trans.Maybe+import Control.Monad.Trans.Reader (ask, asks, runReaderT) import Data.Bits import Data.Data (Typeable) import Data.Int@@ -67,11 +67,14 @@ _ <- liftIO $ Gtk.onIconThemeChanged iconTheme $ do invalidateThemeWindowIconCacheEntries cacheEntries void $ runReaderT refreshTaffyWindows context- _ <-- subscribeToPropertyEvents [ewmhWMIcon] $ \case- PropertyEvent _ _ _ _ windowId' _ _ _ ->- liftIO $ invalidateEWMHWindowIconCacheEntriesForWindow cacheEntries windowId'- _ -> return ()+ maybeX11Context <- asks x11ContextVar+ forM_ maybeX11Context $+ const $+ void $+ subscribeToPropertyEvents [ewmhWMIcon] $ \case+ PropertyEvent _ _ _ _ windowId' _ _ _ ->+ liftIO $ invalidateEWMHWindowIconCacheEntriesForWindow cacheEntries windowId'+ _ -> return () return cache getCachedWindowIcon ::
taffybar.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.4 name: taffybar-version: 5.2.0+version: 5.2.1 synopsis: A desktop bar similar to xmobar, but with more GUI license: BSD-3-Clause license-file: LICENSE
test/unit/System/Taffybar/AppearanceSpec.hs view
@@ -33,20 +33,20 @@ aroundAll withIntegrationEnv $ do it "renders a bar under an EWMH window manager" $ \env -> do goldenFile <- makeAbsolute "test/data/appearance-ewmh-bar.png"- actualPng <- renderBarScreenshot env LegacyLayout LegacyWidget+ actualPng <- renderBarScreenshot env LegacyLayout assertGolden "appearance" goldenFile actualPng it "renders a two-level bar under an EWMH window manager" $ \env -> do goldenFile <- makeAbsolute "test/data/appearance-ewmh-bar-levels.png"- actualPng <- renderBarScreenshot env LevelsLayout LegacyWidget+ actualPng <- renderBarScreenshot env LevelsLayout assertGolden "appearance-levels" goldenFile actualPng - it "renders the channel workspaces widget under an EWMH window manager" $ \env -> do- actualPng <- renderBarScreenshot env LegacyLayout ChannelWidget- assertPngLooksRendered "ewmh-channel-workspaces" actualPng+ it "renders the workspaces widget under an EWMH window manager" $ \env -> do+ actualPng <- renderBarScreenshot env LegacyLayout+ assertPngLooksRendered "ewmh-workspaces" actualPng it "keeps configured bar height when the windows title has oversized glyph metrics" $ \env -> do- actualPng <- renderBarScreenshot env WindowsTitleStressLayout LegacyWidget+ actualPng <- renderBarScreenshot env WindowsTitleStressLayout let actualImg = decodePngRGBA8 "stress" actualPng JP.imageHeight actualImg `shouldBe` 55 @@ -56,17 +56,16 @@ renderBarScreenshotWithArgs env LegacyLayout- LegacyWidget ["--expect-top-strut", "80"] assertPngLooksRendered "ewmh-hidpi-strut" actualPng - it "renders the channel workspaces widget under Hyprland when available" $ do+ it "renders the workspaces widget under Hyprland when available" $ do available <- hyprlandTestAvailable unless available $ pendingWith "Hyprland integration environment unavailable (needs WAYLAND_DISPLAY, HYPRLAND_INSTANCE_SIGNATURE and grim)"- actualPng <- renderHyprlandScreenshot LegacyLayout ChannelWidget- assertPngLooksRendered "hyprland-channel-workspaces" actualPng+ actualPng <- renderHyprlandScreenshot LegacyLayout+ assertPngLooksRendered "hyprland-workspaces" actualPng assertGolden :: String -> FilePath -> BL.ByteString -> IO () assertGolden label goldenFile actualPng = do@@ -130,14 +129,12 @@ data LayoutKind = LegacyLayout | LevelsLayout | WindowsTitleStressLayout -data WidgetKind = LegacyWidget | ChannelWidget--renderBarScreenshot :: Env -> LayoutKind -> WidgetKind -> IO BL.ByteString-renderBarScreenshot env layout widgetKind =- renderBarScreenshotWithArgs env layout widgetKind []+renderBarScreenshot :: Env -> LayoutKind -> IO BL.ByteString+renderBarScreenshot env layout =+ renderBarScreenshotWithArgs env layout [] -renderBarScreenshotWithArgs :: Env -> LayoutKind -> WidgetKind -> [String] -> IO BL.ByteString-renderBarScreenshotWithArgs Env {envTmpDir = tmp} layout widgetKind extraArgs = do+renderBarScreenshotWithArgs :: Env -> LayoutKind -> [String] -> IO BL.ByteString+renderBarScreenshotWithArgs Env {envTmpDir = tmp} layout extraArgs = do exePath <- findComponentExecutable "taffybar-appearance-snap"@@ -152,14 +149,10 @@ LegacyLayout -> [] LevelsLayout -> ["--levels"] WindowsTitleStressLayout -> ["--windows-title-stress"]- widgetArgs =- case widgetKind of- LegacyWidget -> []- ChannelWidget -> ["--channel-workspaces"] pc = setStdout inherit $ setStderr inherit $- proc exePath (["--out", outPath, "--css", cssPath] ++ levelArgs ++ widgetArgs ++ extraArgs)+ proc exePath (["--out", outPath, "--css", cssPath] ++ levelArgs ++ extraArgs) withProcessTerm pc $ \p -> do mEc <- timeout appearanceSnapProcessTimeoutUsec (waitExitCode p)@@ -173,8 +166,8 @@ BL.readFile outPath -renderHyprlandScreenshot :: LayoutKind -> WidgetKind -> IO BL.ByteString-renderHyprlandScreenshot layout widgetKind =+renderHyprlandScreenshot :: LayoutKind -> IO BL.ByteString+renderHyprlandScreenshot layout = withSystemTempDirectory "taffybar-appearance-hyprland" $ \tmp -> do exePath <- findComponentExecutable@@ -188,14 +181,10 @@ LegacyLayout -> [] LevelsLayout -> ["--levels"] WindowsTitleStressLayout -> []- widgetArgs =- case widgetKind of- LegacyWidget -> []- ChannelWidget -> ["--channel-workspaces"] pc = setStdout inherit $ setStderr inherit $- proc exePath (["--out", outPath, "--css", cssPath] ++ levelArgs ++ widgetArgs)+ proc exePath (["--out", outPath, "--css", cssPath] ++ levelArgs) withProcessTerm pc $ \p -> do mEc <- timeout appearanceSnapProcessTimeoutUsec (waitExitCode p) case mEc of