[taffybar] Set icons for workspaces
This commit is contained in:
parent
f48ce23c89
commit
1b0f62cc67
@ -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
|
@ -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 =
|
||||||
|
Loading…
Reference in New Issue
Block a user