module System.Taffybar.WindowSwitcher (
windowSwitcherNew
) where
import Control.Monad (forM_)
import Graphics.UI.Gtk
import Graphics.X11.Xlib.Extras (Event)
import System.Information.EWMHDesktopInfo
import System.Taffybar.Pager
windowSwitcherNew :: Pager -> IO Widget
windowSwitcherNew pager = do
label <- labelNew (Nothing :: Maybe String)
widgetSetName label "label"
let cfg = config pager
callback = pagerCallback cfg label
subscribe pager callback "_NET_ACTIVE_WINDOW"
assembleWidget label
pagerCallback :: PagerConfig -> Label -> Event -> IO ()
pagerCallback cfg label _ = do
title <- withDefaultCtx getActiveWindowTitle
let decorate = activeWindow cfg
postGUIAsync $ labelSetMarkup label (decorate $ nonEmpty title)
assembleWidget :: Label -> IO Widget
assembleWidget label = do
title <- menuItemNew
widgetSetName title "title"
containerAdd title label
switcher <- menuBarNew
widgetSetName switcher "WindowSwitcher"
containerAdd switcher title
rcParseString $ unlines [ "style 'WindowSwitcher' {"
, " xthickness = 0"
, " GtkMenuBar::internal-padding = 0"
, "}"
, "style 'title' {"
, " xthickness = 0"
, " GtkMenuItem::horizontal-padding = 0"
, "}"
, "widget '*WindowSwitcher' style 'WindowSwitcher'"
, "widget '*WindowSwitcher*title' style 'title'"
]
menu <- menuNew
widgetSetName menu "menu"
menuTop <- widgetGetToplevel menu
widgetSetName menuTop "Taffybar_WindowSwitcher"
menuItemSetSubmenu title menu
_ <- on title menuItemActivate $ fillMenu menu
_ <- on title menuItemDeselect $ emptyMenu menu
widgetShowAll switcher
return $ toWidget switcher
fillMenu :: MenuClass menu => menu -> IO ()
fillMenu menu = do
handles <- withDefaultCtx getWindowHandles
if null handles then return () else do
wsNames <- withDefaultCtx getWorkspaceNames
forM_ handles $ \handle -> do
item <- menuItemNewWithLabel (formatEntry wsNames handle)
_ <- onActivateLeaf item $ withDefaultCtx (focusWindow $ snd handle)
menuShellAppend menu item
widgetShow item
emptyMenu :: MenuClass menu => menu -> IO ()
emptyMenu menu = containerForeach menu $ \item ->
containerRemove menu item >> postGUIAsync (widgetDestroy item)
formatEntry :: [String]
-> X11WindowHandle
-> String
formatEntry wsNames ((ws, wtitle, _), _) = wsName ++ ": " ++ (nonEmpty wtitle)
where wsName = if 0 <= ws && ws < length wsNames
then wsNames !! ws
else "WS#" ++ show ws
nonEmpty :: String -> String
nonEmpty x = case x of
[] -> "(nameless window)"
_ -> x