{-# 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