[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
, gtk
, gtk-traymanager>=0.1.6
, mtl
, process
, split
, 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 Control.Exception.Base
import Control.Monad
import Control.Monad.Reader
import Data.List
import Data.List.Split
import qualified Data.Map as M
@ -19,6 +20,7 @@ import System.Information.Memory
import System.Information.X11DesktopInfo
import System.Process
import System.Taffybar
import System.Taffybar.IconImages
import System.Taffybar.LayoutSwitcher
import System.Taffybar.MPRIS2
import System.Taffybar.NetMonitor
@ -30,8 +32,13 @@ import System.Taffybar.Widgets.PollingGraph
import System.Taffybar.WindowSwitcher
import System.Taffybar.WorkspaceHUD
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 =
defaultGraphConfig
@ -114,11 +121,12 @@ myFormatEntry wsNames ((ws, wtitle, wclass), _) =
wsName = M.findWithDefault ("WS#" ++ show wsN) ws wsNames
WSIdx wsN = ws
getInterfaces = do
(_, output, _) <- readCreateProcessWithExitCode (shell "list_interfaces.sh") ""
return $ splitOn "\n" output
swapMaybeIO = maybe (return Nothing) (Just <$>)
main = do
monEither <-
(try $ getEnv "TAFFYBAR_MONITOR") :: IO (Either SomeException String)
@ -126,6 +134,22 @@ main = do
homeDirectory <- getHomeDirectory
let resourcesDirectory = homeDirectory </> ".lib" </> "resources"
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
myGetIconInfo w@WindowData {windowTitle = title, windowClass = klass}
| "URxvt" `isInfixOf` klass = makeIcon "urxvt.png"
@ -163,7 +187,7 @@ main = do
Gtk.widgetSetName theTray "Taffytray"
Gtk.widgetShowAll cont
return $ Gtk.toWidget cont
hudConfig =
myHUDConfig =
defaultWorkspaceHUDConfig
{ underlineHeight = 3
, underlinePadding = 2
@ -172,7 +196,10 @@ main = do
, getIconInfo = myGetIconInfo
, windowIconSize = 25
, widgetGap = 0
-- , widgetBuilder = buildBorderButtonController
, widgetBuilder = buildButtonController $
buildUnderlineController $
buildContentsController
[buildConstantIconController, buildLabelController, buildIconController]
, showWorkspaceFn = hideEmpty
, updateRateLimitMicroseconds = 100000
, updateIconsOnTitleChange = True
@ -188,10 +215,10 @@ main = do
defaultPagerConfig
{useImages = True, windowSwitcherFormatter = myFormatEntry}
-- pager = taffyPagerNew pagerConfig
makeUnderline = underlineWidget hudConfig
makeUnderline = underlineWidget myHUDConfig
pgr <- pagerNew pagerConfig
tray2 <- movableWidget tray
let hud = buildWorkspaceHUD hudConfig pgr
let hud = buildWorkspaceHUD myHUDConfig pgr
los = makeUnderline (layoutSwitcherNew pgr) "red"
wnd = makeUnderline (windowSwitcherNew pgr) "teal"
taffyConfig =