[taffybar] Set icons for workspaces

This commit is contained in:
Ivan Malison 2017-09-12 01:58:47 -07:00
parent f48ce23c89
commit 1b0f62cc67
No known key found for this signature in database
GPG Key ID: 62530EFBE99DC2F8
3 changed files with 35 additions and 7 deletions

View File

@ -20,6 +20,7 @@ executable imalison-taffybar
, filepath , filepath
, gtk , gtk
, gtk-traymanager>=0.1.6 , gtk-traymanager>=0.1.6
, mtl
, process , process
, split , split
, taffybar , taffybar

@ -1 +1 @@
Subproject commit e7a5d0092d823003880dc8337a931eeeb93555a9 Subproject commit 3f64d6da4d2e01ce659540a1a3ef291e5a89848d

View File

@ -3,6 +3,7 @@ module Main where
import qualified Control.Concurrent.MVar as MV import qualified Control.Concurrent.MVar as MV
import Control.Exception.Base import Control.Exception.Base
import Control.Monad import Control.Monad
import Control.Monad.Reader
import Data.List import Data.List
import Data.List.Split import Data.List.Split
import qualified Data.Map as M import qualified Data.Map as M
@ -19,6 +20,7 @@ import System.Information.Memory
import System.Information.X11DesktopInfo import System.Information.X11DesktopInfo
import System.Process import System.Process
import System.Taffybar import System.Taffybar
import System.Taffybar.IconImages
import System.Taffybar.LayoutSwitcher import System.Taffybar.LayoutSwitcher
import System.Taffybar.MPRIS2 import System.Taffybar.MPRIS2
import System.Taffybar.NetMonitor import System.Taffybar.NetMonitor
@ -30,8 +32,13 @@ import System.Taffybar.Widgets.PollingGraph
import System.Taffybar.WindowSwitcher import System.Taffybar.WindowSwitcher
import System.Taffybar.WorkspaceHUD import System.Taffybar.WorkspaceHUD
import Text.Printf import Text.Printf
import Text.Read hiding (get) import Text.Read hiding (get, lift)
data ConstantIconController = ConstantIconController { cicImage :: Gtk.Image }
instance WorkspaceWidgetController ConstantIconController where
updateWidget cic _ = return cic
getWidget = Gtk.toWidget . cicImage
memCfg = memCfg =
defaultGraphConfig defaultGraphConfig
@ -114,11 +121,12 @@ myFormatEntry wsNames ((ws, wtitle, wclass), _) =
wsName = M.findWithDefault ("WS#" ++ show wsN) ws wsNames wsName = M.findWithDefault ("WS#" ++ show wsN) ws wsNames
WSIdx wsN = ws WSIdx wsN = ws
getInterfaces = do getInterfaces = do
(_, output, _) <- readCreateProcessWithExitCode (shell "list_interfaces.sh") "" (_, output, _) <- readCreateProcessWithExitCode (shell "list_interfaces.sh") ""
return $ splitOn "\n" output return $ splitOn "\n" output
swapMaybeIO = maybe (return Nothing) (Just <$>)
main = do main = do
monEither <- monEither <-
(try $ getEnv "TAFFYBAR_MONITOR") :: IO (Either SomeException String) (try $ getEnv "TAFFYBAR_MONITOR") :: IO (Either SomeException String)
@ -126,6 +134,22 @@ main = do
homeDirectory <- getHomeDirectory homeDirectory <- getHomeDirectory
let resourcesDirectory = homeDirectory </> ".lib" </> "resources" let resourcesDirectory = homeDirectory </> ".lib" </> "resources"
inResourcesDirectory file = resourcesDirectory </> file inResourcesDirectory file = resourcesDirectory </> file
getWorkspacePixBuf size Workspace { workspaceIdx = WSIdx wsId } =
pixBufFromFile size . inResourcesDirectory <$>
case wsId + 1 of
1 -> Just "urxvt.png"
2 -> Just "stack-overflow.png"
3 -> Just "bookmark.png"
4 -> Just "tv.png"
_ -> Nothing
buildConstantIconController :: ControllerConstructor
buildConstantIconController ws = do
cfg <- asks hudConfig
lift $ do
img <- Gtk.imageNew
pb <- swapMaybeIO $ getWorkspacePixBuf (windowIconSize cfg) ws
setImage (windowIconSize cfg) img pb
return $ WWC ConstantIconController { cicImage = img }
makeIcon = return . IIFilePath . inResourcesDirectory makeIcon = return . IIFilePath . inResourcesDirectory
myGetIconInfo w@WindowData {windowTitle = title, windowClass = klass} myGetIconInfo w@WindowData {windowTitle = title, windowClass = klass}
| "URxvt" `isInfixOf` klass = makeIcon "urxvt.png" | "URxvt" `isInfixOf` klass = makeIcon "urxvt.png"
@ -163,7 +187,7 @@ main = do
Gtk.widgetSetName theTray "Taffytray" Gtk.widgetSetName theTray "Taffytray"
Gtk.widgetShowAll cont Gtk.widgetShowAll cont
return $ Gtk.toWidget cont return $ Gtk.toWidget cont
hudConfig = myHUDConfig =
defaultWorkspaceHUDConfig defaultWorkspaceHUDConfig
{ underlineHeight = 3 { underlineHeight = 3
, underlinePadding = 2 , underlinePadding = 2
@ -172,7 +196,10 @@ main = do
, getIconInfo = myGetIconInfo , getIconInfo = myGetIconInfo
, windowIconSize = 25 , windowIconSize = 25
, widgetGap = 0 , widgetGap = 0
-- , widgetBuilder = buildBorderButtonController , widgetBuilder = buildButtonController $
buildUnderlineController $
buildContentsController
[buildConstantIconController, buildLabelController, buildIconController]
, showWorkspaceFn = hideEmpty , showWorkspaceFn = hideEmpty
, updateRateLimitMicroseconds = 100000 , updateRateLimitMicroseconds = 100000
, updateIconsOnTitleChange = True , updateIconsOnTitleChange = True
@ -188,10 +215,10 @@ main = do
defaultPagerConfig defaultPagerConfig
{useImages = True, windowSwitcherFormatter = myFormatEntry} {useImages = True, windowSwitcherFormatter = myFormatEntry}
-- pager = taffyPagerNew pagerConfig -- pager = taffyPagerNew pagerConfig
makeUnderline = underlineWidget hudConfig makeUnderline = underlineWidget myHUDConfig
pgr <- pagerNew pagerConfig pgr <- pagerNew pagerConfig
tray2 <- movableWidget tray tray2 <- movableWidget tray
let hud = buildWorkspaceHUD hudConfig pgr let hud = buildWorkspaceHUD myHUDConfig pgr
los = makeUnderline (layoutSwitcherNew pgr) "red" los = makeUnderline (layoutSwitcherNew pgr) "red"
wnd = makeUnderline (windowSwitcherNew pgr) "teal" wnd = makeUnderline (windowSwitcherNew pgr) "teal"
taffyConfig = taffyConfig =