diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,10 @@ +# 3.1.0 + +## New Features + + * A new module Chrome which makes it so that Workspaces can display the + favicons of the website that the chrome window is currently visiting. + # 3.0.0 ## Breaking Changes diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -26,7 +26,7 @@ versionOption = infoOption (printf "taffybar %s" $ showVersion version) ( long "version" - <> help "Show the version number of gtk-sni-tray" + <> help "Show the version number of taffybar" ) main :: IO () diff --git a/src/System/Taffybar.hs b/src/System/Taffybar.hs --- a/src/System/Taffybar.hs +++ b/src/System/Taffybar.hs @@ -154,8 +154,8 @@ dataDir <- getDataDir return (dataDir name) -startCSS :: IO Gtk.CssProvider -startCSS = do +startCSS :: Maybe FilePath -> IO Gtk.CssProvider +startCSS configCssPath = do -- Override the default GTK theme path settings. This causes the -- bar (by design) to ignore the real GTK theme and just use the -- provided minimal theme to set the background and text colors. @@ -165,6 +165,7 @@ doesFileExist filePath >>= flip when (Gtk.cssProviderLoadFromPath taffybarProvider (T.pack filePath)) loadIfExists =<< getDefaultConfigFile "taffybar.css" + mapM_ loadIfExists configCssPath loadIfExists =<< getUserConfigFile "taffybar" "taffybar.css" Just scr <- Gdk.screenGetDefault Gtk.styleContextAddProviderForScreen scr taffybarProvider 800 @@ -181,7 +182,7 @@ _ <- initThreads _ <- Gtk.init Nothing GIThreading.setCurrentThreadAsGUIThread - _ <- startCSS + _ <- startCSS $ cssPath config _ <- buildContext config Gtk.main diff --git a/src/System/Taffybar/Context.hs b/src/System/Taffybar/Context.hs --- a/src/System/Taffybar/Context.hs +++ b/src/System/Taffybar/Context.hs @@ -84,6 +84,7 @@ { dbusClientParam :: Maybe DBus.Client , startupHook :: TaffyIO () , getBarConfigsParam :: BarConfigGetter + , cssPath :: Maybe FilePath , errorMsg :: Maybe String } @@ -96,6 +97,7 @@ { dbusClientParam = Nothing , startupHook = return () , getBarConfigsParam = return [] + , cssPath = Nothing , errorMsg = Nothing } @@ -216,7 +218,8 @@ newConfs = filter (`notElem` currentConfigs) barConfigs (remainingWindows, removedWindows) = partition ((`elem` barConfigs) . sel1) currentWindows - setPropertiesFromPair (barConf, window) = setupStrutWindow (strutConfig barConf) window + setPropertiesFromPair (barConf, window) = + setupStrutWindow (strutConfig barConf) window newWindowPairs <- lift $ do logIO DEBUG $ printf "removedWindows: %s" $ @@ -320,8 +323,8 @@ identifier <- lift newUnique listenersVar <- asks listeners let - -- This type annotation probably has something to do with the warnings that - -- occur without MonoLocalBinds, but it still seems to be necessary + -- XXX: This type annotation probably has something to do with the warnings + -- that occur without MonoLocalBinds, but it still seems to be necessary addListener :: SubscriptionList -> SubscriptionList addListener = ((identifier, listener):) lift $ MV.modifyMVar_ listenersVar (return . addListener) diff --git a/src/System/Taffybar/DBus/Toggle.hs b/src/System/Taffybar/DBus/Toggle.hs --- a/src/System/Taffybar/DBus/Toggle.hs +++ b/src/System/Taffybar/DBus/Toggle.hs @@ -27,6 +27,7 @@ import qualified Data.Map as M import Data.Maybe import qualified GI.Gdk as Gdk +import qualified GI.Gtk as Gtk import Graphics.UI.GIGtkStrut import Paths_taffybar ( getDataDir ) import Prelude @@ -135,6 +136,7 @@ , autoMethod "showOnMonitor" $ takeInt $ toggleTaffyOnMon (const True) , autoMethod "refresh" $ runReaderT refreshTaffyWindows ctx + , autoMethod "exit" (Gtk.mainQuit :: IO ()) ] } lift $ do diff --git a/src/System/Taffybar/Hooks.hs b/src/System/Taffybar/Hooks.hs --- a/src/System/Taffybar/Hooks.hs +++ b/src/System/Taffybar/Hooks.hs @@ -1,7 +1,11 @@ module System.Taffybar.Hooks ( module System.Taffybar.DBus , module System.Taffybar.Hooks + , ChromeTabImageData(..) , refreshBatteriesOnPropChange + , getX11WindowToChromeTabId + , getChromeTabImageDataChannel + , getChromeTabImageDataTable ) where import Control.Applicative @@ -15,6 +19,7 @@ import System.Taffybar.Context import System.Taffybar.DBus import System.Taffybar.Information.Battery +import System.Taffybar.Information.Chrome import System.Taffybar.Information.Network import System.Taffybar.Information.XDG.DesktopEntry import System.Taffybar.Util diff --git a/src/System/Taffybar/Information/Chrome.hs b/src/System/Taffybar/Information/Chrome.hs new file mode 100644 --- /dev/null +++ b/src/System/Taffybar/Information/Chrome.hs @@ -0,0 +1,112 @@ +{-# LANGUAGE OverloadedStrings #-} +module System.Taffybar.Information.Chrome where + +import Control.Concurrent +import Control.Monad +import Control.Monad.Trans.Class +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as LBS +import qualified Data.Map as M +import Data.Maybe +import qualified GI.GLib as Gdk +import qualified GI.GdkPixbuf as Gdk +import Prelude +import System.Log.Logger +import System.Taffybar.Context hiding (logIO, logT) +import System.Taffybar.Information.EWMHDesktopInfo +import System.Taffybar.Information.SafeX11 +import Text.Read hiding (lift) +import Text.Regex +import Web.Scotty + +logIO :: System.Log.Logger.Priority -> String -> IO () +logIO = logM "System.Taffybar.Information.Chrome" + +data ChromeTabImageData = ChromeTabImageData + { tabImageData :: Gdk.Pixbuf + , tabImageDataId :: Int + } + +newtype ChromeTabImageDataState = + ChromeTabImageDataState + (MVar (M.Map Int ChromeTabImageData), Chan ChromeTabImageData) + +getChromeTabImageDataState :: TaffyIO ChromeTabImageDataState +getChromeTabImageDataState = do + ChromeFaviconServerPort port <- fromMaybe (ChromeFaviconServerPort 5000) <$> getState + getStateDefault (listenForChromeFaviconUpdates port) + +getChromeTabImageDataChannel :: TaffyIO (Chan ChromeTabImageData) +getChromeTabImageDataChannel = do + ChromeTabImageDataState (_, chan) <- getChromeTabImageDataState + return chan + +getChromeTabImageDataTable :: TaffyIO (MVar (M.Map Int ChromeTabImageData)) +getChromeTabImageDataTable = do + ChromeTabImageDataState (table, _) <- getChromeTabImageDataState + return table + +newtype ChromeFaviconServerPort = ChromeFaviconServerPort Int + +listenForChromeFaviconUpdates :: Int -> TaffyIO ChromeTabImageDataState +listenForChromeFaviconUpdates port = do + infoVar <- lift $ newMVar M.empty + chan <- lift newChan + _ <- lift $ forkIO $ scotty port $ + post "/setTabImageData/:tabID" $ do + tabID <- param "tabID" + imageData <- LBS.toStrict <$> body + when (BS.length imageData > 0) $ lift $ do + loader <- Gdk.pixbufLoaderNew + Gdk.pixbufLoaderWriteBytes loader =<< Gdk.bytesNew (Just imageData) + Gdk.pixbufLoaderClose loader + pixbuf <- Gdk.pixbufLoaderGetPixbuf loader + let chromeTabImageData = + ChromeTabImageData + { tabImageData = pixbuf + , tabImageDataId = tabID + } + modifyMVar_ infoVar $ \currentMap -> do + writeChan chan chromeTabImageData + return $ M.insert tabID chromeTabImageData currentMap + return $ ChromeTabImageDataState (infoVar, chan) + +newtype X11WindowToChromeTabId = X11WindowToChromeTabId (MVar (M.Map X11Window Int)) + +getX11WindowToChromeTabId :: TaffyIO X11WindowToChromeTabId +getX11WindowToChromeTabId = + getStateDefault $ X11WindowToChromeTabId <$> maintainX11WindowToChromeTabId + +maintainX11WindowToChromeTabId :: TaffyIO (MVar (M.Map X11Window Int)) +maintainX11WindowToChromeTabId = do + startTabMap <- updateTabMap M.empty + tabMapVar <- lift $ newMVar startTabMap + let handleEvent PropertyEvent { ev_window = window } = + do + title <- runX11Def "" $ getWindowTitle window + lift $ modifyMVar_ tabMapVar $ \currentMap -> do + let newMap = addTabIdEntry currentMap (window, title) + logIO DEBUG (show newMap) + return newMap + handleEvent _ = return () + subscribeToEvents ["_NET_WM_NAME"] handleEvent + return tabMapVar + +tabIDRegex :: Regex +tabIDRegex = mkRegexWithOpts "[|]%([0-9]*)%[|]" True True + +getTabIdFromTitle :: String -> Maybe Int +getTabIdFromTitle title = + matchRegex tabIDRegex title >>= listToMaybe >>= readMaybe + +addTabIdEntry :: M.Map X11Window Int -> (X11Window, String) -> M.Map X11Window Int +addTabIdEntry theMap (win, title) = + maybe theMap ((flip $ M.insert win) theMap) $ getTabIdFromTitle title + +updateTabMap :: M.Map X11Window Int -> TaffyIO (M.Map X11Window Int) +updateTabMap tabMap = + runX11Def tabMap $ do + wins <- getWindows + titles <- mapM getWindowTitle wins + let winsWithTitles = zip wins titles + return $ foldl addTabIdEntry tabMap winsWithTitles diff --git a/src/System/Taffybar/SimpleConfig.hs b/src/System/Taffybar/SimpleConfig.hs --- a/src/System/Taffybar/SimpleConfig.hs +++ b/src/System/Taffybar/SimpleConfig.hs @@ -29,8 +29,8 @@ import Graphics.UI.GIGtkStrut import System.Taffybar.Information.X11DesktopInfo import System.Taffybar -import qualified System.Taffybar.Context as BC (BarConfig(..)) -import System.Taffybar.Context hiding (BarConfig(..)) +import qualified System.Taffybar.Context as BC (BarConfig(..), TaffybarConfig(..)) +import System.Taffybar.Context hiding (BarConfig(..), cssPath) import System.Taffybar.Util -- | The side of the monitor at which taffybar should be displayed. @@ -57,6 +57,9 @@ , centerWidgets :: [TaffyIO Gtk.Widget] -- | Widget constructors whose results are placed at the end of the bar , endWidgets :: [TaffyIO Gtk.Widget] + -- | Optional path to CSS stylesheet (loaded in addition to stylesheet found + -- in XDG data directory). + , cssPath :: Maybe FilePath } -- | Sensible defaults for most of the fields of 'SimpleTaffyConfig'. You'll @@ -72,6 +75,7 @@ , startWidgets = [] , centerWidgets = [] , endWidgets = [] + , cssPath = Nothing } toStrutConfig :: SimpleTaffyConfig -> Int -> StrutConfig @@ -108,7 +112,10 @@ newtype SimpleBarConfigs = SimpleBarConfigs (MV.MVar [(Int, BC.BarConfig)]) toTaffyConfig :: SimpleTaffyConfig -> TaffybarConfig -toTaffyConfig conf = defaultTaffybarConfig { getBarConfigsParam = configGetter } +toTaffyConfig conf = + defaultTaffybarConfig { getBarConfigsParam = configGetter + , BC.cssPath = cssPath conf + } where configGetter = do SimpleBarConfigs configsVar <- diff --git a/src/System/Taffybar/Util.hs b/src/System/Taffybar/Util.hs --- a/src/System/Taffybar/Util.hs +++ b/src/System/Taffybar/Util.hs @@ -26,8 +26,6 @@ import qualified Data.GI.Gtk.Threading as Gtk import qualified Data.Text as T import Data.Tuple.Sequence -import GI.GLib.Constants -import GI.Gdk (threadsAddIdle) import qualified GI.GdkPixbuf.Objects.Pixbuf as Gdk import System.Exit (ExitCode (..)) import System.Log.Logger @@ -137,12 +135,5 @@ printf "Failed to load icon from filepath %s" filepath return $ rightToMaybe result -postGUIASync action = - threadsAddIdle PRIORITY_DEFAULT_IDLE (action >> return False) >> return () - --- XXX: This has serious problems becuase it will cause a hang if it is used --- when already on the UI Thread -postGUISync action = do - ans <- newEmptyMVar - threadsAddIdle PRIORITY_DEFAULT_IDLE $ action >>= putMVar ans >> return False - takeMVar ans +postGUIASync = Gtk.postGUIASync +postGUISync = Gtk.postGUISync diff --git a/src/System/Taffybar/Widget/Battery.hs b/src/System/Taffybar/Widget/Battery.hs --- a/src/System/Taffybar/Widget/Battery.hs +++ b/src/System/Taffybar/Widget/Battery.hs @@ -109,12 +109,16 @@ ctx <- ask liftIO $ do image <- imageNew + styleCtx <- widgetGetStyleContext =<< toWidget image defaultTheme <- iconThemeGetDefault let getCurrentBatteryIconNameString = T.pack . batteryIconName <$> runReaderT getDisplayBatteryInfo ctx + extractPixbuf info = + fst <$> iconInfoLoadSymbolicForContext info styleCtx setIconForSize size = do name <- getCurrentBatteryIconNameString - iconThemeLoadIcon defaultTheme name size themeLoadFlags >>= - traverse (scalePixbufToSize size OrientationHorizontal) + iconThemeLookupIcon defaultTheme name size themeLoadFlags >>= + traverse extractPixbuf >>= + traverse (scalePixbufToSize size OrientationHorizontal) updateImage <- autoSizeImage image setIconForSize OrientationHorizontal toWidget =<< channelWidgetNew image chan (const $ postGUIASync updateImage) diff --git a/src/System/Taffybar/Widget/FreedesktopNotifications.hs b/src/System/Taffybar/Widget/FreedesktopNotifications.hs --- a/src/System/Taffybar/Widget/FreedesktopNotifications.hs +++ b/src/System/Taffybar/Widget/FreedesktopNotifications.hs @@ -121,8 +121,8 @@ Nothing -> Just timeout Just maxTimeout -> Just (min maxTimeout timeout) - escapedSummary <- markupEscapeText summary (fromIntegral $ T.length summary) - escapedBody <- markupEscapeText body (fromIntegral $ T.length body) + escapedSummary <- markupEscapeText summary (-1) + escapedBody <- markupEscapeText body (-1) let n = Notification { noteAppName = appName , noteReplaceId = replaceId , noteSummary = escapedSummary @@ -194,7 +194,7 @@ startTimeoutThread s Notification {..} = case noteExpireTimeout of Nothing -> return () Just timeout -> void $ forkIO $ do - threadDelay (fromIntegral timeout * 10^(6 :: Int)) + threadDelay (fromIntegral timeout * 10^(3 :: Int)) notePurge s noteId wakeupDisplayThread s diff --git a/src/System/Taffybar/Widget/MPRIS2.hs b/src/System/Taffybar/Widget/MPRIS2.hs --- a/src/System/Taffybar/Widget/MPRIS2.hs +++ b/src/System/Taffybar/Widget/MPRIS2.hs @@ -144,7 +144,7 @@ playingText :: MonadIO m => Int -> Int -> NowPlaying -> m T.Text playingText artistMax songMax NowPlaying {npArtists = artists, npTitle = title} = - G.markupEscapeText formattedText (fromIntegral $ T.length formattedText) + G.markupEscapeText formattedText (-1) where formattedText = T.pack $ printf "%s - %s" (truncateString artistMax $ intercalate "," artists) diff --git a/src/System/Taffybar/Widget/SNITray.hs b/src/System/Taffybar/Widget/SNITray.hs --- a/src/System/Taffybar/Widget/SNITray.hs +++ b/src/System/Taffybar/Widget/SNITray.hs @@ -13,6 +13,7 @@ import Control.Monad.Trans.Class import Control.Monad.Trans.Reader +import Data.Ratio import qualified GI.Gtk import Graphics.UI.GIGtkStrut import qualified StatusNotifier.Host.Service as H @@ -48,6 +49,7 @@ , trayImageSize = Expand , trayIconExpand = False , trayAlignment = End + , trayOverlayScale = 3 % 5 } _ <- widgetSetClassGI tray "sni-tray" GI.Gtk.widgetShowAll tray @@ -57,5 +59,6 @@ sniTrayNew = getHost False >>= sniTrayNewFromHost sniTrayThatStartsWatcherEvenThoughThisIsABadWayToDoIt :: TaffyIO GI.Gtk.Widget -sniTrayThatStartsWatcherEvenThoughThisIsABadWayToDoIt = getHost True >>= sniTrayNewFromHost +sniTrayThatStartsWatcherEvenThoughThisIsABadWayToDoIt = + getHost True >>= sniTrayNewFromHost diff --git a/src/System/Taffybar/Widget/Util.hs b/src/System/Taffybar/Widget/Util.hs --- a/src/System/Taffybar/Widget/Util.hs +++ b/src/System/Taffybar/Widget/Util.hs @@ -15,7 +15,7 @@ module System.Taffybar.Widget.Util where import Control.Concurrent ( forkIO ) -import Control.Monad ( forever, void ) +import Control.Monad import Control.Monad.IO.Class import Control.Monad.Trans.Maybe import Data.Functor ( ($>) ) @@ -130,22 +130,10 @@ ] getImageForDesktopEntry :: Int32 -> DesktopEntry -> IO (Maybe GI.Pixbuf) -getImageForDesktopEntry size entry = runMaybeT $ do - iconName <- MaybeT $ return $ deIcon entry - let iconNameText = T.pack iconName - MaybeT $ do - iconTheme <- Gtk.iconThemeGetDefault - hasIcon <- Gtk.iconThemeHasIcon iconTheme iconNameText - logPrintFDebug "System.Taffybar.Widget.Util" "Entry: %s" entry - logPrintFDebug "System.Taffybar.Widget.Util" "Icon present: %s" hasIcon - if hasIcon - then - Gtk.iconThemeLoadIcon iconTheme iconNameText size themeLoadFlags - else do - exists <- doesFileExist iconName - if isAbsolute iconName && exists - then Just <$> GI.pixbufNewFromFile iconName - else return Nothing +getImageForDesktopEntry size entry = fmap join $ traverse run $ deIcon entry + where run iconName = + maybeTCombine (loadPixbufByName size $ T.pack iconName) + (getPixbufFromFilePath iconName) loadPixbufByName :: Int32 -> T.Text -> IO (Maybe GI.Pixbuf) loadPixbufByName size name = do @@ -183,4 +171,3 @@ renderWithContext :: GI.Cairo.Context -> C.Render () -> IO () renderWithContext ct r = GI.Cairo.withManagedPtr ct $ \p -> runReaderT (runRender r) (Cairo (castPtr p)) - diff --git a/src/System/Taffybar/Widget/Weather.hs b/src/System/Taffybar/Widget/Weather.hs --- a/src/System/Taffybar/Widget/Weather.hs +++ b/src/System/Taffybar/Widget/Weather.hs @@ -241,12 +241,12 @@ DefaultWeatherFormatter -> do let rawLabel = T.pack $ defaultFormatter labelTpl wi let rawTooltip = T.pack $ defaultFormatter tooltipTpl wi - lbl <- markupEscapeText rawLabel (fromIntegral $ T.length rawLabel) - tooltip <- markupEscapeText rawTooltip (fromIntegral $ T.length rawTooltip) + lbl <- markupEscapeText rawLabel (-1) + tooltip <- markupEscapeText rawTooltip (-1) return (lbl, Just tooltip) WeatherFormatter f -> do let rawLabel = T.pack $ f wi - lbl <- markupEscapeText rawLabel (fromIntegral $ T.length rawLabel) + lbl <- markupEscapeText rawLabel (-1) return (lbl, Just lbl) Left err -> do putStrLn err diff --git a/src/System/Taffybar/Widget/Windows.hs b/src/System/Taffybar/Widget/Windows.hs --- a/src/System/Taffybar/Widget/Windows.hs +++ b/src/System/Taffybar/Widget/Windows.hs @@ -14,15 +14,7 @@ -- which to switch the focus. ----------------------------------------------------------------------------- -module System.Taffybar.Widget.Windows ( - -- * Usage - -- $usage - windowsNew - , WindowsConfig(..) - , defaultWindowsConfig - , truncatedGetActiveLabel - , truncatedGetMenuLabel -) where +module System.Taffybar.Widget.Windows where import Control.Monad import Control.Monad.Trans.Class @@ -37,16 +29,6 @@ import System.Taffybar.Widget.Generic.DynamicMenu import System.Taffybar.Widget.Util --- $usage --- --- The window switcher widget requires that the EwmhDesktops hook from the --- XMonadContrib project be installed in your @xmonad.hs@ file: --- --- > import XMonad.Hooks.EwmhDesktops (ewmh) --- > main = do --- > xmonad $ ewmh $ defaultConfig --- > ... - data WindowsConfig = WindowsConfig { getMenuLabel :: X11Window -> TaffyIO T.Text -- ^ A monadic function that will be used to make a label for the window in @@ -58,11 +40,12 @@ defaultGetMenuLabel :: X11Window -> TaffyIO T.Text defaultGetMenuLabel window = do windowString <- runX11Def "(nameless window)" (getWindowTitle window) - markupEscapeText (T.pack windowString) $ fromIntegral $ length windowString + return $ T.pack windowString defaultGetActiveLabel :: TaffyIO T.Text -defaultGetActiveLabel = fromMaybe "" <$> - (runX11Def Nothing getActiveWindow >>= traverse defaultGetMenuLabel) +defaultGetActiveLabel = do + label <- fromMaybe "" <$> (runX11Def Nothing getActiveWindow >>= traverse defaultGetMenuLabel) + markupEscapeText label (-1) truncatedGetActiveLabel :: Int -> TaffyIO T.Text truncatedGetActiveLabel maxLength = @@ -75,8 +58,8 @@ defaultWindowsConfig :: WindowsConfig defaultWindowsConfig = WindowsConfig - { getMenuLabel = defaultGetMenuLabel - , getActiveLabel = defaultGetActiveLabel + { getMenuLabel = truncatedGetMenuLabel 35 + , getActiveLabel = truncatedGetActiveLabel 35 } -- | Create a new Windows widget that will use the given Pager as diff --git a/src/System/Taffybar/Widget/Workspaces.hs b/src/System/Taffybar/Widget/Workspaces.hs --- a/src/System/Taffybar/Widget/Workspaces.hs +++ b/src/System/Taffybar/Widget/Workspaces.hs @@ -23,7 +23,6 @@ import Control.Monad.Trans.Maybe import Control.Monad.Trans.Reader import Control.RateLimit -import qualified Data.Char as Char import qualified Data.Foldable as F import Data.Int import Data.List (intersect, sortBy) @@ -628,6 +627,10 @@ getWindowIconPixbufFromDesktopEntry :: WindowIconPixbufGetter getWindowIconPixbufFromDesktopEntry size windowData = getWindowIconFromDesktopEntryByClasses size (windowClass windowData) + +getWindowIconPixbufFromChrome :: WindowIconPixbufGetter +getWindowIconPixbufFromChrome _ windowData = + getPixBufFromChromeData $ windowId windowData defaultGetWindowIconPixbuf :: WindowIconPixbufGetter defaultGetWindowIconPixbuf = diff --git a/src/System/Taffybar/WindowIcon.hs b/src/System/Taffybar/WindowIcon.hs --- a/src/System/Taffybar/WindowIcon.hs +++ b/src/System/Taffybar/WindowIcon.hs @@ -1,5 +1,6 @@ module System.Taffybar.WindowIcon where +import Control.Concurrent import Control.Monad import Control.Monad.IO.Class import Control.Monad.Trans.Class @@ -7,6 +8,7 @@ import Data.Bits import Data.Int import Data.List +import qualified Data.Map as M import Data.Maybe import qualified Data.MultiMap as MM import Data.Ord @@ -21,6 +23,7 @@ import System.Log.Logger import System.Taffybar.Context import System.Taffybar.Hooks +import System.Taffybar.Information.Chrome import System.Taffybar.Information.EWMHDesktopInfo import System.Taffybar.Information.X11DesktopInfo import System.Taffybar.Information.XDG.DesktopEntry @@ -88,7 +91,7 @@ :: MonadIO m => Int32 -> Word32 -> m Gdk.Pixbuf pixBufFromColor imgSize c = do - Just pixbuf <- Gdk.pixbufNew Gdk.ColorspaceRgb True 8 imgSize imgSize + pixbuf <- fromJust <$> Gdk.pixbufNew Gdk.ColorspaceRgb True 8 imgSize imgSize Gdk.pixbufFill pixbuf c return pixbuf @@ -124,3 +127,10 @@ getWindowIconFromClasses = getWindowIconForAllClasses getWindowIconFromClass where getWindowIconFromClass size klass = loadPixbufByName size (T.pack klass) + +getPixBufFromChromeData :: X11Window -> TaffyIO (Maybe Gdk.Pixbuf) +getPixBufFromChromeData window = do + imageData <- getChromeTabImageDataTable >>= lift . readMVar + X11WindowToChromeTabId x11LookupMapVar <- getX11WindowToChromeTabId + x11LookupMap <- lift $ readMVar x11LookupMapVar + return $ tabImageData <$> (M.lookup window x11LookupMap >>= flip M.lookup imageData) diff --git a/taffybar.cabal b/taffybar.cabal --- a/taffybar.cabal +++ b/taffybar.cabal @@ -1,5 +1,5 @@ name: taffybar -version: 3.0.0 +version: 3.1.0 synopsis: A desktop bar similar to xmobar, but with more GUI license: BSD3 license-file: LICENSE @@ -43,9 +43,10 @@ , HStringTemplate >= 0.8 && < 0.9 , HTTP , X11 >= 1.5.0.1 + , bytestring , cairo , containers - , dbus >= 1.0.0 && < 2.0.0 + , dbus >= 1.2.1 && < 2.0.0 , dbus-hslogger >= 0.1.0.1 && < 0.2.0.0 , directory , dyre >= 0.8.6 && < 0.9 @@ -56,12 +57,12 @@ , gi-gdk , gi-gdkpixbuf >= 2.0.16 , gi-gdkx11 - , gi-glib + , gi-glib >= 2.0.17 , gi-gtk , gi-gtk-hs , gi-pango , glib - , gtk-sni-tray >= 0.1.4.0 + , gtk-sni-tray >= 0.1.5.0 , gtk-strut >= 0.1.2.1 , haskell-gi >= 0.21.2 , haskell-gi-base >= 0.21.1 @@ -73,8 +74,9 @@ , rate-limit >= 1.1.1 , regex-compat , safe >= 0.3 && < 1 + , scotty >= 11.2 && < 12.0 , split >= 0.1.4.2 - , status-notifier-item >= 0.3.0.0 + , status-notifier-item >= 0.3.0.1 , stm , template-haskell , text @@ -90,7 +92,6 @@ , xml , xml-helpers , xmonad - , xmonad-contrib if flag(network-uri) build-depends: network-uri >= 2.6 && < 3, network >= 2.6 && < 3 @@ -107,6 +108,7 @@ , System.Taffybar.Information.Battery , System.Taffybar.Information.CPU , System.Taffybar.Information.CPU2 + , System.Taffybar.Information.Chrome , System.Taffybar.Information.DiskIO , System.Taffybar.Information.EWMHDesktopInfo , System.Taffybar.Information.MPRIS2 diff --git a/taffybar.hs.example b/taffybar.hs.example --- a/taffybar.hs.example +++ b/taffybar.hs.example @@ -1,4 +1,5 @@ -- -*- mode:haskell -*- +{-# LANGUAGE OverloadedStrings #-} module Main where import System.Taffybar