{-# LANGUAGE OverloadedStrings #-}
module System.Taffybar.Widget.Windows (
windowsNew
, WindowsConfig(..)
, defaultWindowsConfig
, truncatedGetActiveLabel
, truncatedGetMenuLabel
) where
import Control.Monad
import Control.Monad.Trans.Class
import Control.Monad.Trans.Reader
import Data.GI.Gtk.Threading
import qualified Data.Text as T
import qualified GI.Gtk as Gtk
import qualified Graphics.UI.Gtk as Gtk2hs
import System.Taffybar.Compat.GtkLibs
import System.Taffybar.Context
import System.Taffybar.Information.EWMHDesktopInfo
import System.Taffybar.Util
import System.Taffybar.Widget.Generic.DynamicMenu
import System.Taffybar.Widget.Util
data WindowsConfig = WindowsConfig
{ getMenuLabel :: X11Window -> TaffyIO String
, getActiveLabel :: TaffyIO String
}
truncatedGetMenuLabel :: Int -> X11Window -> TaffyIO String
truncatedGetMenuLabel maxLength =
fmap (Gtk2hs.escapeMarkup . truncateString maxLength) .
runX11Def "(nameless window)" . getWindowTitle
truncatedGetActiveLabel :: Int -> TaffyIO String
truncatedGetActiveLabel maxLength =
Gtk2hs.escapeMarkup . truncateString maxLength <$>
runX11Def "(nameless window)" getActiveWindowTitle
defaultWindowsConfig :: WindowsConfig
defaultWindowsConfig =
WindowsConfig
{ getMenuLabel = truncatedGetMenuLabel 35
, getActiveLabel = truncatedGetActiveLabel 35
}
windowsNew :: WindowsConfig -> TaffyIO Gtk2hs.Widget
windowsNew config = (`widgetSetClass` "windows") =<< fromGIWidget =<< do
label <- lift $ Gtk.labelNew Nothing
let setLabelTitle title = lift $ postGUIASync $ Gtk.labelSetMarkup label (T.pack title)
activeWindowUpdatedCallback _ = getActiveLabel config >>= setLabelTitle
subscription <- subscribeToEvents ["_NET_ACTIVE_WINDOW"] activeWindowUpdatedCallback
_ <- liftReader (Gtk.onWidgetUnrealize label) (unsubscribe subscription)
context <- ask
labelWidget <- Gtk.toWidget label
dynamicMenuNew
DynamicMenuConfig { dmClickWidget = labelWidget
, dmPopulateMenu = flip runReaderT context . fillMenu config
}
fillMenu :: Gtk.IsMenuShell a => WindowsConfig -> a -> ReaderT Context IO ()
fillMenu config menu = ask >>= \context ->
runX11Def () $ do
windowIds <- getWindows
forM_ windowIds $ \windowId ->
lift $ do
labelText <- runReaderT (getMenuLabel config windowId) context
let focusCallback = runReaderT (runX11 $ focusWindow windowId) context >> return True
item <- Gtk.menuItemNewWithLabel $ T.pack labelText
_ <- Gtk.onWidgetButtonPressEvent item $ const focusCallback
Gtk.menuShellAppend menu item
Gtk.widgetShow item